在若干列上执行“文本到列” – 需要循环
我有一些代码，我用它来执行文本到列，它在一列上工作正常。
不幸的是，我有多达60列，我需要拆分成列（在表3）。 我想将表3中的a列复制到表4中的a列，并将文本复制到列上。 然后，我想复制第3页中的第B列到第4页中的下一个可用行（在分隔文本之后），然后重复该过程。
当我开始我的macros下面，它似乎是循环通过表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 我认为我的逻辑是好的。 你能准确地看到我要去的地方吗？ 谢谢！
像这样简单的东西应该这样做：
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