Excel的VBA - 动态目的地

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

@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 2

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

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 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 

截图：

享受！