[已解决]关于指定列替换的问题，大师帮忙改下谢谢

wangjiayu_1985

我想把A1列里的数字分别替换成别的，一共有7个要替换的，这7个数量的多少不固定，我自己录制了一个宏，然后复制粘贴，也可以实现，但是感觉好麻烦，请问有简单的代码吗附件里有要替换的表格，
我录制了代码如下
Sub P1A()
Range("A3:A500").Select
    Selection.Replace What:="1", Replacement:="CM1:1", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
  Range("A3:A500").Select
    Selection.Replace What:="2", Replacement:="CM1:2", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
   Range("A3:A500").Select
    Selection.Replace What:="3", Replacement:="CM1:3", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
   Range("A3:A500").Select
    Selection.Replace What:="4", Replacement:="CM1:4", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
  Range("A3:A500").Select
    Selection.Replace What:="5", Replacement:="CM1:5", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
   Range("A3:A500").Select
    Selection.Replace What:="6", Replacement:="CM1:6", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
Range("A3:A500").Select
    Selection.Replace What:="7", Replacement:="CM1:7", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

    替换后  

替换.rar (21.17 KB, 下载次数: 5)

2016-7-9 10:14 上传

点击文件名下载附件
附件

最佳答案

月排行榜 / 总排行榜

雪舞子

2016-7-9 12:28

1. Sub test()
   
2.     Dim arr, yAr, mAr, i&, x&
   
3.     arr = Range("a2").CurrentRegion
   
4.     yAr = Array(1, 2, 3, 4, 5, 6, 7) '查找源数据
   
5.     mAr = Array("CM1:1", "CM2:2", "CM3:3", "CM4:4", "CM5:5", "CM6:6", "CM7:7") '需替换目标数据。yAr与mAr要一一对应。
   
6.     For x = 0 To UBound(yAr)
   
7.         For i = 2 To UBound(arr)
   
8.             If arr(i, 1) = yAr(x) Then arr(i, 1) = mAr(x)
   
9.         Next
   
10.     Next
    
11.     Range("a2").Resize(i - 1, UBound(arr, 2)) = arr
    
12.     MsgBox "替换结束！"
    
13. End Sub

复制代码

跳转到最佳答案楼层

砂海

Range("A3:A500").Select
dim k%
for k=1 to 7

    Selection.Replace What:=k, Replacement:="CM1:"&k, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

next k

砂海

另 : 以目前 的数据 ,不需要 查找 替换 ,直接 在前面 加 "CM1:"

wangjiayu_1985

砂海 发表于 2016-7-9 10:26
Range("A3:A500").Select
dim k%
for k=1 to 7

大师不是得 ，我不一定要替换成什么，这个只是随便打的，没有规律就只是替换

雪舞子

1. Sub test()
   
2.     Dim arr, yAr, mAr, i&, x&
   
3.     arr = Range("a2").CurrentRegion
   
4.     yAr = Array(1, 2, 3, 4, 5, 6, 7) '查找源数据
   
5.     mAr = Array("CM1:1", "CM2:2", "CM3:3", "CM4:4", "CM5:5", "CM6:6", "CM7:7") '需替换目标数据。yAr与mAr要一一对应。
   
6.     For x = 0 To UBound(yAr)
   
7.         For i = 2 To UBound(arr)
   
8.             If arr(i, 1) = yAr(x) Then arr(i, 1) = mAr(x)
   
9.         Next
   
10.     Next
    
11.     Range("a2").Resize(i - 1, UBound(arr, 2)) = arr
    
12.     MsgBox "替换结束！"
    
13. End Sub

复制代码

wangjiayu_1985

雪舞子 发表于 2016-7-9 12:28

谢谢你完美解决了我的问题，非常好用。谢谢。