Question

我试图找出如何将Text循环到列代码。希望让它循环直到最后一个数据或可能是空行/单元格。我可能有超过60个材料清单。感谢任何人都可以提供帮助：）

'Material 1
Range("A2").Select
Selection.TextToColumns Destination:=Range("B2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(16, 1), Array(58, 1), Array(65, 1)), _
TrailingMinusNumbers:=True
Range("A3").Select
Selection.TextToColumns Destination:=Range("F2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(25, 1), Array(37, 1), Array(40, 1), _
Array(43, 1), Array(54, 1), Array(64, 1), Array(73, 1)), TrailingMinusNumbers:=True
Range("A4").Select
Selection.TextToColumns Destination:=Range("O2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 9), Array(26, 1), Array(63, 1)), TrailingMinusNumbers _
:=True




'Material 2
Range("A5").Select
Selection.TextToColumns Destination:=Range("B5"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(16, 1), Array(58, 1), Array(65, 1)), _
TrailingMinusNumbers:=True
Range("A6").Select
Selection.TextToColumns Destination:=Range("F5"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(25, 1), Array(37, 1), Array(40, 1), _
Array(43, 1), Array(54, 1), Array(64, 1), Array(73, 1)), TrailingMinusNumbers:=True
Range("A7").Select
Selection.TextToColumns Destination:=Range("O5"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 9), Array(26, 1), Array(63, 1)), TrailingMinusNumbers _
:=True


'Material 3
Range("A8").Select
Selection.TextToColumns Destination:=Range("B8"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(16, 1), Array(58, 1), Array(65, 1)), _
TrailingMinusNumbers:=True
Range("A9").Select
Selection.TextToColumns Destination:=Range("F8"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(25, 1), Array(37, 1), Array(40, 1), _
Array(43, 1), Array(54, 1), Array(64, 1), Array(73, 1)), TrailingMinusNumbers:=True
Range("A10").Select
Selection.TextToColumns Destination:=Range("O8"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 9), Array(26, 1), Array(63, 1)), TrailingMinusNumbers _
:=True

Answer 1

试试这个。它非常笨重，但是应该遵循循环遍历一列数据的模式，并根据循环当前所在的每个部分中的哪三行执行TextToColumn转换。

这是伪代码逻辑，基于您的示例：

如果在第1行输出到“B”列
如果在第2行输出到“F”列
如果在第3行输出到“O”列...重复每个部分的步骤1-3

这是VBA：

Sub TextToColumnLoop()

    'Set up the variables
    Dim DataCol As String
    Dim Row1Col, Row2Col, Row3Col As String
    Dim FirstRow, LastRow As Integer
    Dim ctr As Integer

    'Your variables (change these to whatever you want)
    '--This enables you to re-use this code and apply it to different data ranges
    DataCol = "A"   '= the column where your data is
    Row1Col = "B"   '= the column where you want the row 1 data outputted
    Row2Col = "F"   '= the column where you want the row 2 data outputted
    Row3Col = "O"   '= the column where you want the row 3 data outputted
    FirstRow = 2    '= cell "A2" in this example
    LastRow = 10    '= cell "A10" in this example --**NOTE:use this to statically set the last row
    ctr = 1         'start on row "1" of the current section

    '**NOTE: Use this while loop to dynamically set the last row in your range (as opposed to the var being set statically, above)
    'While loop to find the active range (loops as long as the cells aren't empty)
    i = FirstRow
    While Me.Range(DataCol & i) <> ""
        i = i + 1
    Wend

    'Set the last non-empty cell as the last cell in the range
    LastRow = i - 1

    'Loop through your rows
    For i = FirstRow To LastRow

        If ctr = 1 Then

            'TextToColumn for Row 1
            Me.Range(DataCol & i).TextToColumns _
            Destination:=Range(Row1Col & i), _
                DataType:=xlFixedWidth, _
                FieldInfo:=Array(Array(0, 1), Array(16, 1), Array(58, 1), Array(65, 1)), _
                TrailingMinusNumbers:=True

            'Increment row counter
            ctr = ctr + 1

        ElseIf ctr = 2 Then

            'TextToColumn for Row 2
            Me.Range(DataCol & i).TextToColumns _
            Destination:=Range(Row2Col & i), _
                DataType:=xlFixedWidth, _
                FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(25, 1), Array(37, 1), _
                    Array(40, 1), Array(43, 1), Array(54, 1), Array(64, 1), Array(73, 1)), _
                TrailingMinusNumbers:=True

            'Increment row counter
            ctr = ctr + 1

        ElseIf ctr = 3 Then

            'TextToColumn for the Row 3
            Me.Range(DataCol & i).TextToColumns _
            Destination:=Range(Row3Col & i), _
                DataType:=xlFixedWidth, _
                FieldInfo:=Array(Array(0, 9), Array(26, 1), Array(63, 1)), _
                TrailingMinusNumbers:=True

            'Reset row counter
            ctr = 1

        End If

    Next i

End Sub

确保将此代码放在VBEditor的工作表对象中，以获取包含数据的工作表。不将此代码放在模块中，因为它使用 Me.Range（）（即，“Me”=当前工作表）语法，而不是表格（“Sheet1”）。范围（），其中明确命名工作表名称。

如果您在说“工作表对象”与“模块”时对我的意思感到困惑，请查看截图 here

Answer 2

我实际上已经解决了这个问题，但由于我是VBA的新手（就像一个月前开始认识VB一样），所以我不确定我的代码有多高效，或者有没有更好的方法来做到这一点。我是根据网上的一些研究做到的。但我会尝试mb2011所建议的内容，看看我能从那里学到什么：）

＆＃13;

Dim LastRowA As Long
Dim i As Long
Dim j As Long
Dim p As Long

    

LastRowA = Range("A" & rows.Count).End(xlUp).Row
   
    
    'Looping first line starting Range A2
    For i = 2 To LastRowA Step 3 'step 3 to count every 3rd row
        Cells(i, 1).TextToColumns Destination:=Cells(i, 2), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(16, 1), Array(58, 1), Array(65, 1)), _
        TrailingMinusNumbers:=True
    Next i
  
    'Looping second line Range A3
    For j = 3 To LastRowA Step 3
    Cells(j, 1).TextToColumns Destination:=Cells(j - 1, 6), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(25, 1), Array(37, 1), Array(40, 1), _
        Array(43, 1), Array(54, 1), Array(64, 1), Array(73, 1)), TrailingMinusNumbers:=True
    Next j

    'Looping third line Range A4
    For p = 4 To LastRowA Step 3
    Cells(p, 1).TextToColumns Destination:=Cells(p - 2, 15), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 9), Array(26, 1), Array(63, 1)), TrailingMinusNumbers _
        :=True
    Next p

＆＃13;

Answer 3

下面的代码将文本循环到任意大小的数据集的列。

 Sub TextToColumns()

'Deines Last Row
    Dim LastRow As Long
    LastRow = 1048576 'the last row possible in excel
    'optional alternative **LastRow** Code
       'Counts number of rows (counts from last row of Column A):
         'Dim LastRow As Long
         'LastRow = Cells(Rows.Count, "A").End(xlUp).Row

'Counts number of Columns (my headers start in row 1)
    Dim LastColumn As Long
    LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column

'Loops Text to columns
    Dim StartingRow, StaringColumn As Long
    StartingRow = 1

    For StartingColumn = 1 To LastColumn
        Range(Cells(StartingRow, StartingColumn), Cells(LastRow, StartingColumn)).Select

        Selection.TextToColumns , DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True

    Next

End Sub

Excel VBA＆＃39;文本到列＆＃39;环

3 个答案: