Question

我不熟悉在VBA中编写宏。

我正致力于自动化流程。

这就是我需要做的事情

示例数据
Sheet 1中

Group_Name
  RootGrp1
  RootGrp2
  RootGrp3

Sheet 2中

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

过程

它解析Sheet1。
对于每个条目，它会将Sheet2中所有相应的Member_Names添加到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宏。

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

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

1 个答案: