[已解决]求教【民族的汉字都变成1-58的数字】？

eikok

求教【民族的汉字都自动变成1-58的数字】？

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2014-9-17 14:57

1. Sub aaa()
   
2. Dim arr, i&, d As Object
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheets(1).[a1].CurrentRegion
   
5. For i = 1 To UBound(arr)
   
6.   d(arr(i, 2)) = i
   
7. Next i
   
8. arr = Sheets(2).[a1].CurrentRegion
   
9. For i = 1 To UBound(arr)
   
10.   arr(i, 1) = d(arr(i, 1))
    
11. Next i
    
12. Sheets(2).[d1].Resize(UBound(arr)) = arr
    
13. End Sub

复制代码

跳转到最佳答案楼层

baksy

“效果”工作表的A1单元格公式，下拉；
=VLOOKUP(原始数据!A1,IF({1,0},民族代码!B$1:B$58,民族代码!A$1:A$58),2,0)

eikok

baksy 发表于 2014-9-17 14:18
效果工作表的A1单元额公式，下拉；
=VLOOKUP(原始数据!A1,IF({1,0},民族代码!B$1:B$58,民族代码!A$1:A$58) ...

求教 能用vba吗？

ghostjiao

1. Sub demo()
   
2.     Dim dic As Object, i%, arr, irow%, AR
   
3.     Set dic = CreateObject("scripting.dictionary")
   
4.     arr = Sheets("民族代码").Range("a1").CurrentRegion
   
5.     For i = 1 To UBound(arr)
   
6.         dic(arr(i, 2)) = arr(i, 1)
   
7.     Next
   
8.     With Sheets("原始数据")
   
9.         irow = .Cells(Rows.Count, "A").End(xlUp).Row
   
10.         arr = .Range("a1:a" & irow)
    
11.         ReDim AR(1 To irow)
    
12.         For i = 1 To UBound(arr)
    
13.             If dic.exists(arr(i, 1)) Then
    
14.                 AR(i) = dic(arr(i, 1))
    
15.             End If
    
16.         Next
    
17.         .Range("b1").Resize(irow, 1) = Application.Transpose(AR)
    
18.     End With
    
19.     Set dic = Nothing
    
20. End Sub
    

复制代码

看看符合要求吗

大灰狼1976

1. Sub aaa()
   
2. Dim arr, i&, d As Object
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheets(1).[a1].CurrentRegion
   
5. For i = 1 To UBound(arr)
   
6.   d(arr(i, 2)) = i
   
7. Next i
   
8. arr = Sheets(2).[a1].CurrentRegion
   
9. For i = 1 To UBound(arr)
   
10.   arr(i, 1) = d(arr(i, 1))
    
11. Next i
    
12. Sheets(2).[d1].Resize(UBound(arr)) = arr
    
13. End Sub

复制代码

eikok

ghostjiao 发表于 2014-9-17 14:55
看看符合要求吗

求教直接在原始数据上变呢？

eikok

大灰狼1976 发表于 2014-9-17 14:57

求教直接在原始数据上变呢？
就是原来的汉字，直接就变成代码

ghostjiao

.Range("b1").Resize(irow, 1) = Application.Transpose(AR)
改成
.Range("a1").Resize(irow, 1) = Application.Transpose(AR)
但只能运行一次

大灰狼1976

Sheets(2).[a1].Resize(UBound(arr)) = arr
其他如楼上所说

eikok

大灰狼1976 发表于 2014-9-17 15:25
Sheets(2).[a1].Resize(UBound(arr)) = arr
其他如楼上所说

求教自动在原表上男变1女变2；民族变数字