1

列へのテキストを実行するために使用するコードがいくつかあり、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 に答える