MS-Excel - 宏将单个单元格从一个工作表复制到另一个工作表

我是在VBA中编写宏的新手。MS-Excel - 宏将单个单元格从一个工作表复制到另一个工作表

我正在自动化一个过程。

这是我需要做的

样本数据
工作表Sheet1

Group_Name 
    RootGrp1 
    RootGrp2 
    RootGrp3

Sheet2中

Group_Name - Member_Name 
    RootGrp1 - Member_A 
    RootGrp1 - Member_B 
    RootGrp1 - Member_C 
    RootGrp2 - Member_D 
    RootGrp2 - Member_B 
    RootGrp2 - Member_C 
    RootGrp3 - Member_A 
    RootGrp3 - Member_B 
    RootGrp3 - Member_E 
    Member_A - Member_F

结果
Sheet 1中改性

Group_Name 
    RootGrp1 
    RootGrp2 
    RootGrp3 
    Member_A 
    Member_B 
    Member_C 
    Member_D 
    Member_E 
    Member_F

过程

它解析通过Sheet 1中。
对于当前的每个条目，它将所有对应的Member_Names从Sheet2添加到Sheet1。（注意忽略已经添加的任何Member_Name）
重复处理Sheet1中的所有条目。（包括动态添加的）

有没有办法做到这一点？请帮忙！！！

下面是我想出了到现在为止的代码。面对目前FindNext方法的一些问题。

Sub My_Function() 


    Sheets(1).Activate 
    Range("A2").Select 
    Set Marker = Cells(ActiveCell.Row, ActiveCell.Column) 


    Do Until IsEmpty(Marker) 

     Query = Marker.Value 
     With Sheets(2).Range("A1", "A20") 
      Set Index = .Find(Query, LookIn:=xlValues) 
      If Not Index Is Nothing Then 
       firstAddress = Index.Address 

       Do 
        Result = Index.Offset(0, 1) 

        With Sheets(1).Range("A1", Range("A65536").End(xlUp)) 
         Set Lookup = .Find(Result, LookIn:=xlValues) 
         If Lookup Is Nothing Then 
          Worksheets(1).Range("A65536").End(xlUp).Offset(1, 0).Value = Result 
         End If 
        End With 

        Set Index = .FindNext(Index) 
       Loop While Not Index Is Nothing And Index.Address <> firstAddress 
      End If 
     End With 

     Set Marker = Marker.Offset(1, 0) 
    Loop 

End Sub

P.S - 我知道代码写得不是很好。请原谅，因为这是我第一个正确的VBA宏。

来源

2011-12-28 MacroNoob

+1了良好的书面问题。简单的答案是“是的，它可以完成”。你已经试图写一个宏来做到这一点？如果是这样，编辑你的问题，包括你迄今为止做了什么;如果您先尝试自己解决问题，您将得到最多的帮助。 – 2011-12-28 07:22:22

我同意瑞秋。如果你不知道从哪里开始，你可以看一下[Excel宏记录器]（http://www.mrexcel.com/articles/record-modify-run-excel-macro.php） – JMax 2011-12-28 07:45:12

I'至今已上传代码。嵌套的Find和FindNext方法。 – MacroNoob 2011-12-28 08:10:39

看看这个。稍微调整了你的代码。

Sub fMain() 
    Sheets(1).Activate 
    Range("A2").Select 
    Set Marker = Cells(ActiveCell.Row, ActiveCell.Column) 
    Do Until IsEmpty(Marker) 
     Query = Marker.Value 
     With Sheets(2).Range("A2", "A20") 
      Set Index = .Find(Query, LookIn:=xlValues) 
      If Not Index Is Nothing Then 
       firstAddress = Index.Address 
       Do 
        Result = Index.Offset(0, 1) 
        fHelper Result 
        Set Index = .Find(What:=Query, After:=Index) 
       Loop While Not Index Is Nothing And Index.Address <> firstAddress 
      End If 
     End With 
     Set Marker = Marker.Offset(1, 0) 
    Loop 
End Sub 

Sub fHelper(Result) 
    With Sheets(1).Range("A2", Range("A65536").End(xlUp)) 
     Set Lookup = .Find(Result, LookIn:=xlValues) 
     If Lookup Is Nothing Then 
      Worksheets(1).Range("A65536").End(xlUp).Offset(1, 0).Value = Result 
     End If 
    End With 
End Sub

来源

2011-12-28 08:29:56 Khemka

MS-Excel - 宏将单个单元格从一个工作表复制到另一个工作表

回答

相关问题