修改查找和替换的 VBA 代码以循环遍历多个工作表

Question

我有以下代码用于在名为“Front_Wing”的工作表中搜索一系列单元格。它将与工作表中名为“Acronyms”列 A 的值匹配的任何单元格值替换为“Acronyms”列 B 中的单元格值。

我有多个工作表，而不仅仅是“Front_Wing”，所以我想修改此代码以循环访问多个工作表。

Private Sub CommandButton2_Click()

Dim wsR As Worksheet
Dim wsData As Worksheet
Dim rng As Range, rngR As Range
Dim i As Long
Dim rngReplacement
Dim c As Range
Dim curVal As String

Set ws = ThisWorkbook.Sheets("Front_Wing")
Set wsR = ThisWorkbook.Sheets("Acronyms")

i = ws.Rows.Count

With ws
    Set rng = ws.Range("B10", ws.Range("C" & i).End(xlUp))
End With

With wsR
    Set rngR = .Range("A1", .Range("A" & i).End(xlUp))
End With


For Each c In rngR
    curVal = c.Value

    With rng
        .Replace curVal, c.Offset(0, 1).Value, xlWhole, , True

    End With

Next


End Sub

Answer 1

Sub CommandButton2_Click()
   Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        If InStr(0, ws.NAME, "wsName1,wsName2,wsName3") > 0 Then ' wsName1,wsName2,wsName3 = worksheets that you wnat to process
           ProcessYourWorksheet (ws)
        End If
    Next ws
End Sub

Private Sub ProcessYourWorksheet(Worksheet As ws)

End Sub

Answer 2

让我们看看我能不能和你一起挣扎……

Dim i as integer, WSArray as String, LRA as Long, LR as Long

LRA = Sheets("Acronym").Cells(Rows.Count, "A").End(xlUp).Row

WSArray=Array("Front_Wing","Bodywork_Internal","Bodywork_Lower","Chassis")

For i = 1 to LR

LR=Sheets(WSArray).Cells(Rows.Count, "A").End(xlUp).Row

'Edit#01, adding something for if statement:
If Sheets(WSArray).Cells(i,1).Value=Application.Index("A1:A" & LRA,Application.Match(Sheets(WSArray).Cells(i,1),Sheets("Acronym").Range("A1:A" & LRA)) Then

    Sheets(WSArray).Cells(i,1).Value=Application.Index("B1:B" & LRA,Application.Match(Sheets(WSArray).Cells(i,1),Sheets("Acronym").Range("A1:A" & LRA))
    Else
    End If

Next i

我最好的猜测是为工作表指定多个名称。

Answer 3

Assuming your code runs, this should iterate through the worksheets
Private Sub CommandButton2_Click()

Dim wsR As Worksheet
Dim ws As Worksheet
Dim rng As Range, rngR As Range
Dim i As Long
Dim rngReplacement
Dim c As Range
Dim curVal As String
'Since wsR is where you get your comparison values, declare it. 

Set wsR = ThisWorkbook.Sheets("Acronyms")

'This loop will go through each worksheet that is not "Acronym" the rest is the same code as yours. 

For Each ws in Activeworkbook.worksheets

if ws.name <> "Acronyms" then
i = ws.Rows.Count

With wsR
    Set rngR = .Range("A1", .Range("A" & i).End(xlUp))
End With

With ws
    Set rng = ws.Range("B10", ws.Range("C" & i).End(xlUp))
End With

For Each c In rngR
    curVal = c.Value

    With rng
    .Replace curVal, c.Offset(0, 1).Value, xlWhole, , True
End With

Next
end if

next ws
    End Sub

Answer 4

这是一种使用 Select Case 的方法，因此只需列出您希望宏覆盖的工作表即可。

Private Sub CommandButton2_Click()

Dim wsR As Worksheet
Dim ws As Worksheet
Dim rng As Range, rngR As Range
Dim rngReplacement
Dim c As Range
Dim curVal As String

Set wsR = ThisWorkbook.Sheets("Acronyms")

With wsR
    Set rngR = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
End With

For Each ws In Worksheets
    Select Case ws.Name
        Case "Bodywork_Internal", "Bodywork_Lower", "Chassis"
            With ws
                Set rng = .Range("B10", .Range("C" & .Rows.Count).End(xlUp))
            End With
            For Each c In rngR
                curVal = c.Value
                With rng
                    .Replace curVal, c.Offset(0, 1).Value, xlWhole, , True
                End With
            Next c
    End Select
Next ws

End Sub