VBA循环通过多个工作表

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

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

这里有两个版本，一个使用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 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 

结束小组