VBA代碼的Excel搜索，替換不同列上的相應數據

Question

我有以下（簡化的）示例，試圖在Excel中讓vba為我做些事情。 有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

使用“查找/查找下一個”查找所有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

使用您自己的代碼，您無需將范圍var分配給“范圍對象選擇”，而是將范圍var設置為范圍對象。

Set searchrange = ActiveCell.EntireColumn

如何避免在Excel VBA中使用選擇

Answer 2

這將提示您輸入要搜索的ID，並輸入新的Type來設置這些行。 這也使用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