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 - 宏將單個單元格從一個工作表複製到另一個工作表

回答

相關問題