excel的vba代码进行搜索，替换不同列上的相应数据

Question

我有下面的（简化的）示例，我试图让 vba 在 excel 中为我做一些事情。有 3 列，第二列和第三列可能有不同的标题，但数据基本相同。我想保留这两列。

我想仅在第二列中查找某些内容，然后替换具有我正在搜索的值的行的第一列中的值。因此，作为一个简单的示例，我将仅在第 2 列中搜索所有“505”，然后将这些对应行的第 1 列替换为“A”。

请注意，这个庞大的电子表格及其数据每天都在变化，因此没有固定的行数或“505”的频率。所以我需要这个循环。此外，即使大部分数据是重复的，我也需要保留第 2 列和第 3 列。有人可以提供一种简单而强大的方法吗？提前致谢！

TYPE    ID  Model
E   505 505
E   505 505
E   505 505
E   505 505
E   606 606
E   606 606
E   606 606
E   606 606

代码：

Sub searchrange()
'
' searchrange Macro
'
Dim searchrange As Range
    Range("A1").Select
    Cells.Find(What:="id", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

   'this below line is what I am having trouble with; I need to get the (active, or certain) column to be defined as the search range.
    searchrange = ActiveCell.EntireColumn.Select

    Selection.Find(What:="606", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.Offset(0, -1).FormulaR1C1 = "A"

    Cells.FindNext(After:=ActiveCell).Activate
    Selection.Offset(0, -1).FormulaR1C1 = "A"

End Sub

Answer 1

使用 Find/FindNext 定位所有 505 个单元格。将您的发现收集到一个联盟中。偏移联合范围以更改第一列中的值。

Option Explicit

Sub Macro1()
    Dim rng As Range, addr As String, fnd As Variant, rngs As Range
    dim i as long, arr as variant

    arr = array("505", "A", "506", "B", "507", "C", "508", "D", "509", "E")

    With Worksheets("Sheet2").Columns(2)
        for i=lbound(arr) to ubound(arr) step 2
            fnd = arr(i)
            Set rng = .Find(What:=fnd, After:=.Cells(1), LookAt:=xlWhole, _
                            LookIn:=xlFormulas, MatchCase:=False, SearchFormat:=False)
            If Not rng Is Nothing Then
                addr = rng.Address(0, 0)
                Set rngs = rng
                Do
                    Set rngs = Union(rngs, rng)
                    Set rng = .FindNext(After:=rng)
                Loop Until rng.Address(0, 0) = addr
            End If

            If Not rngs Is Nothing Then _
                rngs.Offset(0, -1) = arr(i+1)
        next i
    End With

End Sub

使用您自己的代码，您不会将范围变量分配给“范围对象选择”您将范围变量设置为范围对象。

Set searchrange = ActiveCell.EntireColumn

How to avoid using Select in Excel VBA

Answer 2

另一个选项会提示您输入要搜索的 ID 和将这些行设置为的新类型。这也使用 AutoFilter 方法而不是 Range 循环来显示不同类型的解决方案：

Sub ReplaceType()

    'Change these to the actual columns for your data
    Const sTypeCol As String = "A"
    Const sIDCol As String = "B"

    Dim ws As Worksheet
    Dim rUpdate As Range
    Dim sIDFind As String
    Dim sNewType As String

    sIDFind = InputBox("Enter the ID to search for:", "ID")
    If Len(sIDFind) = 0 Then Exit Sub   'Pressed cancel

    sNewType = InputBox("Enter the new Type for ID [" & sIDFind & "]:", "New Type")
    If Len(sNewType) = 0 Then Exit Sub  'Pressed cancel

    Set ws = ActiveWorkbook.ActiveSheet
    If ws.AutoFilterMode = True Then ws.AutoFilterMode = False
    With ws.Range(ws.Cells(1, sIDCol), ws.Cells(ws.Rows.Count, sIDCol).End(xlUp))
        If .Rows.Count = 1 Then
            MsgBox "No data on sheet [" & ws.Name & "]" & Chr(10) & "Make sure the correct sheet is selected."
            Exit Sub
        End If
        .AutoFilter 1, sIDFind
        On Error Resume Next
        Set rUpdate = Intersect(ws.Columns(sTypeCol), .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow)
        On Error GoTo 0
        .AutoFilter
    End With

    If Not rUpdate Is Nothing Then
        rUpdate.Value = sNewType
        MsgBox "Updated " & rUpdate.Cells.Count & " cells for ID [" & sIDFind & "] to new Type: " & sNewType
    Else
        MsgBox "No IDs found matching [" & sIDFind & "]", , "No Matches"
    End If

End Sub

Answer 3

你可以使用公式：

Sub searchrange()
    With Range("A2", Cells(Rows.Count, 1).End(xlUp)) ' reference active sheet column A cells from row 2 down to last not empty one
        .FormulaR1C1 = "=IF(RC3=505,""A"",""E"")" ' write referenced cells with a formula that places an "A" if corresponding column C cell content is 505, otherwise an "E" 
        .Value = .Value ' get rid of formulas and leave values only
    End With
End Sub

以上假设 A 列中的 dfault 值为“E”。 如果这不是真的并且 A 列的单元格内容可能是任何内容，那么代码会发生一些变化，利用 D 列中的辅助范围

Sub searchrange2()
    With Range("A2", Cells(Rows.Count, 1).End(xlUp)) ' reference active sheet column A cells from row 2 down to last not empty one
        .Offset(, 3).FormulaR1C1 = "=IF(RC3=505,""A"",RC1)" ' write referenced cells offset three column to the right (i.e. column D) with a formula that places an "A" if corresponding column C cell content is 505, otherwise the content of corresponding column A cell 
        .Value = .Offset(, 3).Value ' write formula result in column A cells 
        .Offset(, 3).ClearContents ' clear "helper" column D 
    End With
End Sub