值和代码间的批量转换，有复选值的转换

ligan01

有三张表，【表VALUE】是值表，【表CODE】是转换后的代码表，【表KEYWORD】为代码与值的对应表。
需要将【表VALUE】根据【表KEYWORD】转换为【表CODE】。
本来可以用VLOOKUP函数进行批量转换。
但有个问题，【表VALUE】中的值，有多选项，比如一个单元格有多个值，{,AAA,BBB,}，这类复选的值，用VLOOKUP函数查找不出。
请教各位老师，能不能用VBA程序解决这个问题。

附件为测试表。

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j, k, t, dic
  Set dic = CreateObject("scripting.dictionary")
  arr = Sheets("keyword").[a1].CurrentRegion.Value
  For i = 2 To UBound(arr, 1)
    dic(arr(i, 2)) = arr(i, 3)
  Next
  arr = Sheets("value").[a1].CurrentRegion.Resize(, 5).Value
  For i = 2 To UBound(arr, 1)
    For j = 3 To 5
      t = Split(arr(i, j), ",")
      For k = 1 To UBound(t) - 1
        If dic.exists(t(k)) Then t(k) = dic(t(k)) Else t(k) = "?"
      Next
      arr(i, j) = Join(t, ",")
    Next
  Next
  Sheets("code").[a1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub

cui26896

你的原要求涂色处是错误的。



值和代码间的批量转换，有复选值的转换.zip (25.62 KB, 下载次数: 3)

2020-2-9 08:37 上传

点击文件名下载附件

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("keyword")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     arr = .Range("a2:c" & r)
   
9.     For i = 1 To UBound(arr)
   
10.       d(arr(i, 2)) = arr(i, 3)
    
11.     Next
    
12.   End With
    
13.   With Worksheets("value")
    
14.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
15.     arr = .Range("c2:e" & r)
    
16.     For i = 1 To UBound(arr)
    
17.       For j = 1 To UBound(arr, 2)
    
18.         brr = Split(arr(i, j), ",")
    
19.         For k = 0 To UBound(brr)
    
20.           If d.exists(brr(k)) Then
    
21.             brr(k) = d(brr(k))
    
22.           End If
    
23.         Next
    
24.         arr(i, j) = Join(brr, ",")
    
25.       Next
    
26.     Next
    
27.     .Range("c2").Resize(UBound(arr), UBound(arr, 2)) = arr
    
28.   End With
    
29. End Sub
    

复制代码

chxw68

详见附件。

ligan01

谢谢各位老师的解答，问题已解决
拜谢