MS-Excel - ワークシート内の一意のセルを別のワークシートにコピーするマクロ

Question

VBAでマクロを書くのが初めてです。

私はプロセスの自動化に取り組んでいます。

これは私が

サンプルデータ
次の使用例は、シート1

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 

を行うために必要なものですこれは、シート1を解析した結果
Sheet1の修飾

Group_Name 
    RootGrp1 
    RootGrp2 
    RootGrp3 
    Member_A 
    Member_B 
    Member_C 
    Member_D 
    Member_E 
    Member_F 

プロセス

1. 。
2. 存在するすべてのエントリに対して、対応するすべてのMember_NamesをSheet2からSheet1に追加します。 （既に追加されているMember_Nameは無視してください）
3. 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マクロであるので、申し訳ありません。

Answer 1

これを確認してください。あなたのコードを微調整。

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