1

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

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

如果工作表 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 回答