Question

我有以下代码用于搜索名为＆＃34; Front_Wing＆＃34;的工作表中的一系列单元格。它将替换与Worksheet中名为＆＃34;缩略语＆＃34;的缩写相匹配的任何单元格值。列A中的单元格值为＆＃34;缩略词＆＃34; B栏。

我有多个工作表，不仅仅是＃34; Front_Wing＆＃34;，所以我想修改此代码以循环遍历多个工作表。

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

这是一种使用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

Answer 3

让我们看看我是否能够与你斗争......

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 4

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

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

4 个答案: