Question

我正在尝试创建一个用户友好的excel接口，以使用vba替换大型数据集中的值。

我有一个小表，其中包含“替换什么”和“替换为”列以及工作表中的大数据集。

我的目标是点击一个按钮并让宏使用数据上的查找功能在“替换什么列”中查找数字，然后粘贴“替换为”列的相应行中的数据。

到目前为止，这是我的代码：

Sub ReplaceItems()
Dim replaceList As Range

Set replaceList = ListItems("Table4").ListColummns("Replace What").DataBodyRange

Dim item As Range

For Each Cell In replaceList.Cells
    Cell.Offset(0, 1).Select.Copy
    item = ActiveWorksheet.Find(Cell.Value)
    item.Select.Paste

Next Cell

End Sub

Answer 1

您可以使用字典快速将Replace What键映射到Replace With值。然后检查一个键是否出现在单元格的值中（您可以使用Index-match和InStr / RegEx的组合，但我可能只是遍历单元格）。最后从单元格中删除键并复制值，您可以使用Left（）和Right（）函数在一行中执行此操作

实施例。使用字典

Sub dictionary()
    Dim key As String, value As String, var As Variant
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")
    key = "my key"
    value = "my value"

    d.Add key, value
    d.Add key & 1, value & 1

    For Each var In d.keys
        MsgBox var & " : " & d.item(var)
    Next var
End Sub

实施例。用值

替换键

Sub ReplaceItems()
    Dim s As String, k As String, v As String, index As Integer
    s = "this is my key, I think"
    k = "key"
    v = "value"
    index = InStr(s, k)
    MsgBox Left(s, index - 1) & v & Right(s, Len(s) - index - Len(k) + 1)
End Sub

Answer 2

我碰巧有这种惯例所以我会分享。
就像Alter发布的那样，我使用 Dictionary 。

Sub test()
    Dim RepList As Range, RepItem As Range
    Dim rng As Range, ldbase As Variant
    Dim i As Long

    With Sheet1 '~~> contains your table, change to suit
        Set RepList = .Range("Table4[Replace What]")
    End With

    With Sheet2 '~~> contains your large database, change to suit
        '~~> transfer your database in an array
        '~~> I this example, my target is the whole column B with data.
        Set rng = .Range("B2", .Range("B" & .Rows.Count).End(xlUp))
        ldbase = Application.Transpose(rng) 'dumps range values to array
    End With

    With CreateObject("Scripting.Dictionary")
        '~~> first transfer your list in Dictionary
        For Each RepItem In RepList
            If Not .Exists(RepItem.Value) Then
                .Add RepItem.Value, RepItem.Offset(0, 1).Value
            End If
        Next
        '~~> here is the actual find and replace
        For i = LBound(ldbase) To UBound(ldbase)
            If .Exists(ldbase(i)) Then ldbase(i) = .Item(ldbase(i))
        Next
        rng = Application.Transpose(ldbase) '~~> dumps array values to range
    End With
End Sub

HTH。

查找并替换和循环表

2 个答案: