VBA代码的Excel搜索,替换不同列上的相应数据

时间:2018-07-17 18:48:34

标签: excel vba search replace range

我有以下(简化的)示例,我试图让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

3 个答案:

答案 0 :(得分: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

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

Set searchrange = ActiveCell.EntireColumn

How to avoid using Select in Excel VBA

答案 1 :(得分:0)

替代方法将提示您输入要搜索的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

答案 2 :(得分:0)

您可以使用公式:

cap=cv2.Videocapture(0)
i=0
while(i<50):
    ret,frame=cap.read() //change car -> cap
    print ret
上面的

假定A列中的dfault值为“ E”。 如果不是真的,并且A列的单元格内容可以是什么,那么代码会发生一些变化,利用D列中的帮助程序范围

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