Question

我的第一个工作表包含许多填充列。在底部，我有代码将这些列中的一个复制到第二个工作表并执行文本到列。然后，它重复将另一列复制到第二张表中的下一个可用列的过程。

问题： 似乎当代码在第二个工作表的特定列的第一个单元格中遇到空白时，text to columns操作无法正常工作。

如果表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

Answer 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

对多列执行文本到列时，空格似乎会影响分隔过程

1 个答案: