Question

我有一些代码用于执行文本到列，并且它对我来说在一列上运行正常。

不幸的是，我需要将多达60列分成列（在表3中）。我想将表3中的列a复制到表4中的列a，并对其上的列执行文本。然后我想将工作表3中的B列复制到工作表4中的下一个可用行（在分隔文本之后），然后重复该过程。

当我在下面启动我的宏时，它似乎是在第3页循环，但在运行之后，表4中没有任何内容。

Sub LoopColumns()


Dim i As Integer, j As Integer

For i = 1 To 60
'Check to see if column is blank
If WorksheetFunction.CountBlank(ActiveSheet.Columns(i)) <> 1048576 Then
Columns(i).Select
Selection.Copy
Sheets("Sheet4").Select

For j = 1 To 10000
If WorksheetFunction.CountBlank(ActiveSheet.Columns(j)) <> 1048576 Then
Columns(j).Select
ActiveSheet.Paste
Columns(j).Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
End If
Next j

End If
Sheets("Sheet3").Select
Next i

End Sub

我认为我的逻辑还可以。你能看到我错在哪里吗？谢谢！

Answer 1

像这样简单的东西应该这样做：

Sub LoopColumns()


Dim i As Integer, x As Integer

For i = 1 To 60

    If Excel.WorksheetFunction.CountBlank(Excel.Sheets("Sheet3").Columns(i)) <> 1048576 Then

        Excel.Sheets("Sheet3").Columns(i).Copy

        x = Excel.Sheets("Sheet4").Cells(1, Columns.Count).End(Excel.xlToLeft)(1, 2).Column

        If x = 2 Then
        x = 1
        Else: x = x
        End If

        Excel.Sheets("Sheet4").Select
        Excel.Sheets("Sheet4").Columns(x).EntireColumn.Select
        Excel.ActiveSheet.Paste

        Excel.Application.CutCopyMode = False
        Selection.TextToColumns Destination:=Cells(1, x), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
                Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
                :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
                Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True

    End If



Next i

Excel.Sheets("Sheet3").Select

End Sub

编辑以取出上述

中稍微奇怪的IF语句

Sub LoopColumns()


Dim i As Integer, x As Integer

For i = 1 To 60

    If Excel.WorksheetFunction.CountBlank(Excel.Sheets("Sheet3").Columns(i)) <> 1048576 Then

        Excel.Sheets("Sheet3").Columns(i).Copy

        x = Excel.Sheets("Sheet4").Cells(1, Columns.Count).End(Excel.xlToLeft).Column

        Excel.Sheets("Sheet4").Select

        If Cells(1, x) <> "" Then x = x + 1


            Excel.Sheets("Sheet4").Columns(x).EntireColumn.Select
            Excel.ActiveSheet.Paste

            Excel.Application.CutCopyMode = False
            Selection.TextToColumns Destination:=Cells(1, x), DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
                    Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
                    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
                    Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True

    End If



Next i

Excel.Sheets("Sheet3").Select

End Sub

在许多列上执行“text to columns” - 需要循环

1 个答案: