1

私の最初のワークシートには、いくつかの塗りつぶされた列が含まれています。下部には、これらの列の1つを2番目のシートにコピーし、テキストを列に実行するコードがあります。次に、別の列を2番目のシートの次の使用可能な列にコピーするプロセスを繰り返します。

問題： コードが2番目のシートの特定の列の最初のセルで空白を検出すると、テキストから列へのアクションが正しく機能しないようです。

シート1（「貼り付け」）の列が次のようになっている場合：

------------------------------------------
Column 1    column 2   column 3  column 4
a b         c  d                  e  f           
g h         i  j       k l        m n

シート2（ "TOP LINE"）の列にテキストを送信すると、誤って次のようになります。

---------------------------------------------------
C1  C2  C3  C4  C5  C6  C7  C8  
a    b   c   d   e   f
g    h   i   j   k   n

したがって、シート1の列3のセル1が空であることが判明した後、列4の後のシート2のテキストの一部が欠落しています（lとmが消えています）。これは以下のコードから次の行にあると思いますが、正直なところわかりません。

   Selection.TextToColumns Destination:=Cells(1, b), DataType:=xlDelimited,

どんな助けでも大歓迎です、私はこれで私の髪を引き裂いています！

Sub TextToColumns()

Dim a As Integer, b As Integer, cell As Range, column As Range


Excel.Application.DisplayAlerts = False
Excel.Sheets("TOP LINE").Select
Cells.Select
Cells.ClearContents

For a = 1 To 60

If Application.WorksheetFunction.CountA(Excel.Sheets("Paste In").Columns(a)) > 0 Then
Excel.Sheets("Paste In").Columns(a).Copy
b = Excel.Sheets("TOP LINE").Cells(1, Columns.Count).End(Excel.xlToLeft).column
Excel.Sheets("TOP LINE").Select


  If Application.WorksheetFunction.CountA(Excel.Sheets("TOP LINE").Columns(b)) > 0      Then b = b + 1
    Excel.Sheets("TOP LINE").Columns(b).EntireColumn.Select
    Excel.ActiveSheet.Paste
   Excel.Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Cells(1, b), 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 a

ActiveSheet.Columns.AutoFit
ActiveSheet.Rows.AutoFit

End Sub
4

1 に答える 1

1 
Sub TextToColumns()

    Dim a As Integer, b As Integer        
    Dim shtTop As Worksheet, shtPaste As Worksheet
    Dim wsf As WorksheetFunction

    Set wsf = Application.WorksheetFunction
    Set shtTop = ActiveWorkbook.Sheets("TOP LINE")
    Set shtPaste = ActiveWorkbook.Sheets("Paste In")

    Application.DisplayAlerts = False
    shtTop.Cells.ClearContents

    For a = 1 To 60

        If wsf.CountA(shtPaste.Columns(a)) > 0 Then

            b = shtTop.Cells(1, Columns.Count).End(Excel.xlToLeft).Column
            Do While wsf.CountA(shtTop.Columns(b)) > 0
                b = b + 1
            Loop

            shtPaste.Columns(a).Copy shtTop.Cells(1, b)
            Application.CutCopyMode = False

            shtTop.Columns(b).TextToColumns Destination:=shtTop.Columns(b), _
                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 a

    With shtTop
        .Activate
        .Columns.AutoFit
        .Rows.AutoFit
    End With

End Sub
于 2012-11-07T22:34:39.197 に答える