请把表一当中的数字转换为对应的表二表三中的文字

天外飞仙重出

请把表一当中的数字转换为对应的表二表三中的文字，如表四。大几百人的档案要填写，不知道有没有好的办法？请高手指教！请看附件。

shiruiqiang

正则，三个字典的问题

quqiyuan

数据不多，用find方法搞，仅供参考。。。

quqiyuan

代码如下。。。
Sub test()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    t = Timer
    Dim wb As Workbook, sht As Worksheet, sh As Worksheet
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("sheet1")
    With sht
        arr = .[a1].CurrentRegion
        Set Rng = .[j1].CurrentRegion
        Set rng2 = .[m1:ac45]
        s = Split(.[a2], "：")(1)
        .[a2] = Split(.[a2], "：")(0) & rng2.Find(s, , , xlWhole).Offset(, 1).Value
        .[e2] = Rng.Find(.[e2], , , xlWhole).Offset(, -1).Value
        For i = 4 To UBound(arr)
            For j = 2 To UBound(arr, 2)
                If Len(arr(i, j)) <> 0 Then
                    .Cells(i, j) = rng2.Find(arr(i, j), , , xlWhole).Offset(, 1).Value
                End If
            Next
        Next
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "共耗时：" & Format(Timer - t, "0.0000") & " 秒！！！", 64
End Sub

icit

回答的都不错啊？我也来凑个热闹。

天外飞仙重出

请大神们赐教，拜谢！

usedrange

1. Sub tt()
   
2.     Dim ar, b2, b3, i%, j%
   
3.     Dim d As Object
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     With Sheet1
   
6.         ar = .[a4].CurrentRegion
   
7.         b2 = .[j3].CurrentRegion
   
8.         b3 = .[m3].CurrentRegion
   
9.         For i = 3 To UBound(b2)
   
10.             d(b2(i, 2)) = b2(i, 1)
    
11.         Next i
    
12.         For i = 3 To UBound(b3)
    
13.             For j = 1 To UBound(b3, 2) Step 3
    
14.                 If b3(i, j) <> "" Then
    
15.                     d(b3(i, j)) = b3(i, j + 1)
    
16.                 End If
    
17.             Next j
    
18.         Next i
    
19.         For i = 2 To UBound(ar)
    
20.             If InStr(ar(i, 1), "单位") Then
    
21.                 t = Split(ar(i, 1), "：")(1)
    
22.                 ar(i, 1) = "单位名称：" & d(CInt(t))
    
23.             End If
    
24.             For j = 2 To UBound(ar, 2)
    
25.                 If IsNumeric(ar(i, j)) Then
    
26.                     t = ar(i, j)
    
27.                 End If
    
28.                 If d.exists(ar(i, j)) Then
    
29.                     ar(i, j) = d(t)
    
30.                 End If
    
31.             Next j
    
32.         Next i
    
33.         .[a31].Resize(UBound(ar), UBound(ar, 2)) = ar
    
34.     End With
    
35.     Set d = Nothing
    
36. End Sub

复制代码

今铭昔