1

我正在寻找一种方法让我的代码更简单、更高效,并创建一个循环,直到它到达最后一个字符。

首先,我得到的数据总是看起来像下面的例子,应该连续粘贴(通常是单元格 A1):

7666976-15012020092737.pdf;7665725-15012020092757.pdf;7669477-15012020092833.pdf;7669483-15012020092844.pdf;7669492-15012020092857.pdf;7669494-15012020092910.pdf;7669495-15012020092921.pdf;7669546-15012020092933.pdf;7669548-15012020092953.pdf;7669548-15012020093010.pdf;7669551-15012020093047.pdf;7669552-15012020093111.pdf;7669554-15012020093138.pdf;7669557-15012020093205.pdf;7669558-15012020093245.pdf;7669563-15012020093311.pdf;7672877-15012020093344.pdf;7672879-15012020093401.pdf;7672881-15012020093415.pdf;7672882-15012020093425.pdf;7672884-15012020093437.pdf

然后我使用Excel 中的Text to Column - Fixed Width选项将其拆分。每个片段的长度应始终为 28 个字符。

到目前为止,我设法创建了下面有效的代码,但我相信它可能会更好 - 例如,如果有 1000 个字符,我应该继续添加 Array(728,1)、Array (756,1) 等。到代码。

Range("A1").Select
    Selection.TextToColumns Destination:=Range("S1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(28, 1), Array(56, 1), Array(84, 1), Array(112, 1), _
        Array(140, 1), Array(168, 1), Array(196, 1), Array(224, 1), Array(252, 1), Array(280, 1), _
        Array(308, 1), Array(336, 1), Array(364, 1), Array(392, 1), Array(420, 1), Array(448, 1), _
        Array(476, 1), Array(504, 1), Array(532, 1), Array(560, 1), Array(588, 1), Array(616, 1), _
        Array(642, 1), Array(672, 1), Array(700, 1)), TrailingMinusNumbers:=True

如何改进?

4

2 回答 2

2

如评论中所述,您可能只使用该Split功能:

Sub Test()

Dim arr As Variant

With Sheet1 'Change according to your sheet's codename
    arr = Split(.Range("A1").Value, "; ")
    .Range("S1").Resize(, UBound(arr) + 1).Value = arr
End With

End Sub

虽然Range.TextToColumns也不差。; 因为您实际上想用分号而不是分号来分隔,所以有两个* 选项:

  • 首先从原始字符串中删除空格/分号:

      Sub Test
    
      With Sheet1 'Change according to your sheet's codename
          .Range("A1").Value = .Range("A1").Replace(" ", "")
          .Range("A1").TextToColumns .Range("S1"), DataType:=1, Semicolon:=True
      End With
    
      End Sub
    
  • Application.Trim在您的代码运行后立即使用以立即从所有单元格中删除前导/尾随空格:

      Sub Test
    
      With Sheet1 'Change according to your sheet's codename
          .Range("A1").TextToColumns .Range("S1"), DataType:=1, Semicolon:=True
          Application.Trim (.Rows(1))
      End With
    
      End Sub
    

后者不会影响您的A1价值,因此您可能想要这样做。


*注意:设置ConsecutiveDelimiter为根据EEM 的回答True使用多个分隔符。

于 2020-01-15T14:11:40.637 回答
2

您需要同时使用两个分隔符(即分号和空格)。

尝试这个:

With ThisWorkbook.Sheets("TEST")
    .Cells(1).TextToColumns Destination:=Range("S1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, _
        Semicolon:=True, Space:=True
    .Range("S1").CurrentRegion.Columns.AutoFit
End With
于 2020-01-15T15:02:42.007 回答