VBA "Text to Column - Fixed Width" 的代码 - 循环
VBA code for "Text to Column - Fixed Width" - loop
我正在寻找一种方法使我的代码更简单、更高效,并创建一个循环 运行 直到它到达最后一个字符。
首先,我得到的数据总是看起来像下面的示例,应该粘贴在一行中(通常是单元格 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
如何改进?
如评论中所述,您可能只使用 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
也不错。因为您实际上想用 ;
而不是分号来分隔,所以有 两个 * 选项:
首先从原始字符串中删除 spaces/semicolons:
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
在您的代码 运行 立即从所有单元格中删除 leading/trailing 空格后立即使用 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
设置为 True
可以根据 .
使用多个定界符
您需要同时使用两个分隔符(即分号和 space)。
试试这个:
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
我正在寻找一种方法使我的代码更简单、更高效,并创建一个循环 运行 直到它到达最后一个字符。
首先,我得到的数据总是看起来像下面的示例,应该粘贴在一行中(通常是单元格 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
如何改进?
如评论中所述,您可能只使用 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
也不错。因为您实际上想用 ;
而不是分号来分隔,所以有 两个 * 选项:
首先从原始字符串中删除 spaces/semicolons:
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
在您的代码 运行 立即从所有单元格中删除 leading/trailing 空格后立即使用
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
设置为 True
可以根据
您需要同时使用两个分隔符(即分号和 space)。
试试这个:
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