1

我有一些代码用于对列执行文本，它对我来说在一列上运行良好。

不幸的是，我有多达 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

我觉得我的逻辑没问题。你能看到我到底哪里错了吗？谢谢！

4

1 回答 1

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
于 2012-11-02T11:54:41.067 回答