Question

我正在处理一个宏来执行以下操作：在“W”列中，我的描述为xxx_yyy_zzz，我想将这些信息用“_”分隔给不同的列。

根据下面的代码，我已经能够为一行做到这一点。

我正在尝试做的一步一步：

1）复制W列上的单元格（本例中我将使用单元格“W2”）

2）转到B列并使用TextToColums粘贴（分隔，标准为“_”）：

B2 = xxx

C2 = yyy

D2 = zzz

3）返回colum W并为下一个单元格执行相同的过程。（W3）

4）这样做直到W列上的下一个单元格为空。

5）PS：如果B列上的单元格不是空白（之前已填充过），请返回W列上的以下单元格并执行相同的过程。

我的主要问题是“目的地”（在这种情况下为B6），每次从一条线移动到另一条线时都会有所不同。

Sub Macro4()


    Range("W6").Select
    Selection.Copy

    If ActiveCell.Offset(0, -21).Value = "" Then

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("B6"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1)), TrailingMinusNumbers:=True


      Else

    ActiveCell.Offset(1, 0).Select
    End If



End Sub

Answer 1

我建议采用一种稍微不同的方法，它循环遍历W列中的每个单元格。我假设如果B已经包含某些东西，那么你不需要做任何事情。

Sub x()

Dim r As Long, v As Variant

For r = 1 To Range("W" & Rows.Count).End(xlUp).Row
    If Len(Cells(r, "W")) > 0 Then
        If Len(Cells(r, "B")) = 0 Then
            v = Split(Cells(r, "W"), "_")
            Cells(r, "B").Resize(, UBound(v) + 1).Value = v
        End If
    End If
Next r

End Sub

Answer 2

您可以在一个操作中执行整个列（除非您出于某种原因确实需要检查每个单元格）。

Dim lastRow As Long
lastRow = Range("W" & Rows.Count).End(xlUp).Row

With Range("W6:W" & lastRow)
    .TextToColumns Destination:=Range("B6"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="_", _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True
End With

VBA文本到Colums +循环结构

2 个答案: