Question

如何为以下快照修复以下代码？

我试过下面的代码

Dim Rng3 As Range
Dim Rng5 As Range

For Each Rng3 In CurCell_1


   For Each Rng5 In CurCell_3

          lLFs = VBA.Len(Rng3) - VBA.Len(VBA.Replace(Rng3, vbLf, ""))

     If lLFs > 0 Then

        Range("B27").Select
        Selection.Copy

        Sheets("AccountModule").Select
        Range("AY2").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

      End If
   Next
Next

但同样不起作用。

Input

Output

Answer 1

我建议您使用不同类型的例程：

Sub separ8(src, trg)
 Dim r As Range, ar
 For Each r In src.Rows
   ar = Split(r.Cells(1, 2), Chr(10))
   For Each el In ar
     trg.Value = r.Cells(1, 1)
     trg.Offset(0, 1) = el
     Set trg = trg.Offset(1)
   Next el
 Next r
End Sub

我的子假设您的输入数据位于src给出的范围内，结果应写入从trg开始的范围。

所以，当有这样的数据时

  A   B      C
1
2     abc    123
             456
             789
3     xyz    1234
             456789
             78941

程序调用

separ8 [b2:c3],[b7]

会得到这个结果：

   A    B    C
 6
 7      abc  123
 8      abc  456
 9      abc  789
10      xyz  1234
11      xyz  456789
12      xyz  78941

使用Excel中的VbA代码复制数据的代码

1 个答案: