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

Posted 2023-03-11

【中文标题】修改查找和替换的 VBA 代码以循环遍历多个工作表

【英文标题】：Modify VBA code for find and replace to loop through multiple Worksheets

【发布时间】：2017-12-24 22:27:10

【问题描述】：

我有以下代码用于在名为“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

【问题讨论】：

您是否要遍历所有工作表，但仍只查看“首字母缩略词”作为替换值？

不是全部，只有少数几个，即：“Bodywork_Internal”、“Bodywork_Lower”和“Chassis”。但是是的 - 总是在看“首字母缩略词”

由于它是特定的工作表，因此您可以创建一个循环来遍历一组工作表名称（您给出的名称）。那将是最简单的，而不是遍历所有文件并限制几张纸，imo。

是的 Cyril，但这是我正在努力解决的循环代码

我刚刚开始起草答案，但我承认我不是最擅长使用数组。需要对其进行一些测试。

【参考方案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

【讨论】：

嗨，理查德。这不会循环遍历所有工作表吗？我只想指定我在上面评论中提到的少数几个。

For Each wsName In Array("name1, "name2") 和Set ws = ThisWorkbook.Worksheets(wsName) 怎么样？

【参考方案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

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

【参考方案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

【参考方案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

【讨论】：

略有更新以缩短一点。请您接受答案吗？网站就是这样运作的，但您似乎还没有这样做。