Question

我在帐户A：C

中有帐号，＃，名称

acct    #   name
1585    1   name_1
1585    2   name_2
1585    3   name_3
1585    4   name_4
1585    5   name_5
1586    6   name_6
1586    7   name_7
1586    8   name_8
1586    9   name_9
1586    10  name_10
1587    11  name_11
....

宏组＃和使用chr（10）返回的acct命名。

代码开始定义分组的目的地，如下所示：

E2 =帐户
F2 =按帐户

当acct更改时，我希望目标行偏移到下面的下一行。

例如：

当acct = 1586时，目的地应切换到E3和F3，

当acct = 1587时，目的地应切换到E4和F4，依此类推

如何在我的代码中构建动态偏移？是否有查找下一个空行功能

我可以对当前代码进行任何调整以提高效率吗？

这是我第一次使用VBA和StackOverFlow进行编码。任何帮助将不胜感激

Sub GroupChrRtn()
Range("A2").Select

Do Until IsEmpty(ActiveCell)
If Selection.Value = Selection.Offset(1, 0).Value Then
        Range("E2").Value = Selection.Value
        If Range("F2").Value = "" Then
            Range("F2").Value = _
                Selection.Offset(0, 1).Value & " " & Selection.Offset(0, 2).Value
        Else
           Range("F2").Value = Range("F2").Value & Chr(10) & _
                Selection.Offset(0, 1).Value & " " & Selection.Offset(0, 2).Value
        End If
    ActiveCell.Offset(1, 0).Select
Else
    Range("F2").Value = Range("F2").Value & Chr(10) & _
                Selection.Offset(0, 1).Value & " " & Selection.Offset(0, 2).Value
    ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub

Answer 1

忘了选择它是非常低效的。

r=2
DO while not isempty(cells(r,1))
 if cells(r,1)=cells(r+1,1) then
   ' do your stuff

 else
  ' do your other stuff
 end if
 r=r+1
LOOP

Answer 2

@CRondao建议很有帮助。

这是我使用的最终代码，引用了匹配值的范围：

Sub GroupChrRtn()

Dim LastRow As Long
Dim Sizes As Range

LastSize = ActiveSheet.Range("N65536").End(xlUp).Row
Set Sizes = ActiveSheet.Range(Cells(2, 14), Cells(LastSize, 14))

 r = 1

For Each c In Sizes.Cells

 Do While Cells(r, 1) = c.Value
    If c.Offset(0, 4).Value = "" Then
        c.Offset(0, 4).Value = _
        Cells(r, 1).Offset(0, 3).Value & " " & Cells(r, 1).Offset(0, 4).Value
     Else
        c.Offset(0, 4).Value = c.Offset(0, 4).Value & Chr(10) & _
        Cells(r, 1).Offset(0, 3).Value & " " & Cells(r, 1).Offset(0, 4).Value
     End If
 r = r + 1
 Loop
Next
End Sub

Answer 3

我的观点，使用了疯狂的Offset。当然，免责声明是YMMV，因为这纯粹是许多其他方法的替代品。

<强>代码：

Sub Group()

    Dim RngAcct As Range, RngNum As Range, RngName As Range
    Dim RngResAcct As Range, RngResNumName As Range
    Dim StrResOne As String, StrResTwo As String

    With ThisWorkbook.Sheets("Sheet1")
        Set RngAcct = .Range("A2")
        Set RngNum = RngAcct.Offset(0, 1)
        Set RngName = RngNum.Offset(0, 1)
        Set RngResAcct = .Range("E2")
        Set RngResNumName = .Range("F2")
    End With

    StrResTwo = ""
    Do Until IsEmpty(RngAcct)
        StrResOne = RngAcct.Value
        If RngAcct.Offset(1, 0).Value = StrResOne Then
            StrResTwo = StrResTwo & RngNum.Value & " " & RngName.Value & Chr(10)
            RngResAcct.Value = StrResOne
            RngResNumName.Value = StrResTwo
        Else
            StrResTwo = StrResTwo & RngNum.Value & " " & RngName.Value
            RngResAcct.Value = StrResOne
            RngResNumName.Value = StrResTwo
            Set RngResAcct = RngResAcct.Offset(1, 0)
            Set RngResNumName = RngResNumName.Offset(1, 0)
            StrResTwo = ""
        End If
        Set RngAcct = RngAcct.Offset(1, 0)
        Set RngNum = RngAcct.Offset(0, 1)
        Set RngName = RngNum.Offset(0, 1)
    Loop

End Sub

<强>截图：

enter image description here

享受！

Excel VBA - 动态目标

3 个答案: