查找和replace，并通过表循环

我试图做一个用户友好的Excel界面，以取代大数据集中的值使用VBA。

我有一个小的表，“replace”和“replace”和在工作表中的大数据集在一起。

我的目标是点击一个button，并使用数据查找function的macros来查找replace内容列中的数字，然后粘贴replace列的相应行中的数据。

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

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为”键映射到“replace为”值。 然后检查一个键是否出现在单元格的值中（可以使用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 

防爆。 用键replace键值

 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。