Question

我正在构建代码，可以遍历多个工作表上的列（B5：B）来查找匹配值。如果一个工作表的列（B5：B）上的值等于工作表名称，则工作表名称将放置在找到值的相邻列（C5：C）上。我不是程序员，但我一直在学习VBA来实现这一目标。到目前为止，我尝试过使用For Next循环（从第3张开始），在Thisworkbook.sheets方法中使用For Each ws失败。但我似乎无法使其发挥作用。我在互联网上搜索过类似的东西，但没有骰子。任何建议将不胜感激。

Sub MatchingPeople()
    Dim c As Variant
    Dim lastrow As Long
    Dim i As Variant
    Dim g As Long
    Dim w As Long

    i = Sheets("Anthony").Name
    g = Sheets("Anthony").Cells(Rows.Count, "C").End(xlUp).Row

    For w = 3 To Sheets.Count
        lastrow = Sheets(w).Cells(Rows.Count, 2).End(xlUp).Row
        Set NewRang = Sheets("Anthony").Cells(g + 1, 3)
        On Error Resume Next
        With Sheets(w).Range(Cells(5, 2), Cells(lasty, 2))
            Set c = .Find(i, LookIn:=xlValues)
            If Not c Is Nothing Then
                firstaddress = c.Address
                Do
                    NewRang.Value = Sheets(w).Name
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstaddress
            End If
        End With
    Next w
End Sub

Answer 1

以下是2个版本，一个使用Find代码，如代码，另一个使用For循环

Option Explicit

Public Sub MatchingPeopleFind()
    Dim i As Long, lrColB As Long
    Dim wsCount As Long, wsName As String
    Dim found As Variant, foundAdr As String

    wsCount = Worksheets.Count
    If wsCount >= 3 Then
        For i = 3 To wsCount
            With Worksheets(i)
                wsName = .Name
                lrColB = .Cells(.Rows.Count, 2).End(xlUp).Row
                With .Range(.Cells(5, 2), .Cells(lrColB, 2))
                    Set found = .Find(wsName, LookIn:=xlValues)
                    If Not found Is Nothing Then
                        foundAdr = found.Address
                        Do
                            found.Offset(0, 1).Value2 = wsName
                            Set found = .FindNext(found)
                        Loop While Not found Is Nothing And found.Address <> foundAdr
                    End If
                End With
            End With
        Next
    End If
End Sub

Public Sub MatchingPeopleForLoop()
    Dim wsCount As Long, wsName As String, i As Long, j As Long

    wsCount = Worksheets.Count
    If wsCount >= 3 Then
        For i = 3 To wsCount
            With Worksheets(i)
                wsName = .Name
                For j = 5 To .Cells(.Rows.Count, 2).End(xlUp).Row
                    If .Cells(j, 2).Value2 = wsName Then .Cells(j, 3).Value2 = wsName
                Next
            End With
        Next
    End If
End Sub

Answer 2

Sub Bygone（）

Dim x As Long

Dim y As Long

Dim z As Long

Dim w As Long

Dim a As Long

Dim b As Long

Dim c As Long

Dim m As Long

a = Sheets.Count

For m = 3 To a

   x = Sheets(m).Cells(3, 3).Value

       For b = 3 To a

            w = Sheets(b).Cells(Rows.Count, 1).End(xlUp).row

                For z = 5 To w

                    y = Sheets(b).Cells(z, 1)

                        Select Case x

                            Case y
                              c =Sheets(m).Cells(Rows.Count,3).End(xlUp).Offset(1, 0).row
                              Sheets(m).Cells(c, 3).Value = Sheets(b).Name
                         End Select
                Next z

      Next b
Next m

End Sub

VBA循环通过多个工作表

2 个答案: