提取字符串内数字后相加重命名

转角处的沉思

请教实现截图效果谢谢

清风竹-

  公式         =LEFT($C$1,2)&1000+MID(A2,1,FIND(".",A2)-1)

yanglinzi

请测试。。

1. Sub 提取数字()
   
2. Dim arr, i, j, r
   
3. With Sheet1
   
4.     r = .Cells(Rows.Count, 1).End(xlUp).Row
   
5.     arr = .Range("a1").Resize(r, 3)
   
6. End With
   
7. For i = 2 To UBound(arr)
   
8.     sa = arr(i, 1)
   
9.     c = Val(Split(sa, ".")(0))
   
10.     sb = Val(Split(arr(1, 3), "M")(1))
    
11.     arr(i, 2) = "NM" & sb + c
    
12. Next
    
13. Range("a1").Resize(r, 3) = arr
    
14. End Sub
    

复制代码

yanglinzi

请测试。。

转角处的沉思

清风竹- 发表于 2024-9-2 08:55
公式         =LEFT($C$1,2)&1000+MID(A2,1,FIND(".",A2)-1)

感谢帮忙，受启发因C1单元格后面数字也不是固定的调整为=LEFT($C$1,2)&RIGHT($C$1,4)+MID(A2,1,FIND(".",A2)-1)。

ykcbf1100

VBA参与一下。。。

转角处的沉思

yanglinzi 发表于 2024-9-2 09:03
请测试。。

感谢帮忙直接使用附件运行发现找不到工程，将代码辅助出来运行倒是没问题了。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.9.2
   
2.     r = Cells(Rows.Count, 1).End(3).Row
   
3.     arr = [a1].Resize(r, 3)
   
4.     st = [c1].Value
   
5.     st1 = Left(st, 2)
   
6.     num = Val(Mid(st, 3))
   
7.     For i = 2 To UBound(arr)
   
8.         arr(i, 3) = st1 & (num + Val(arr(i, 1)))
   
9.     Next
   
10.     [c1].Resize(r, 1) = Application.Index(arr, 0, 3)
    
11. End Sub
    

复制代码

转角处的沉思

ykcbf1100 发表于 2024-9-2 09:08
VBA参与一下。。。

感谢帮忙，效果很好，这种格式保存是为了节省容量吗。

usedrange

1. Sub tt()
   
2.     Dim ar, br, a, i%, j%, t, q, s
   
3.     ar = Sheet1.[a2].Resize([a2].End(4).Row - 1, 1)
   
4.     ReDim br(1 To UBound(ar), 1 To 1)
   
5.     a = [c1]
   
6.     t = Right(a, 4)
   
7.     q = Left(a, 2)
   
8.     For i = 1 To UBound(ar)
   
9.         s = Split(ar(i, 1), ".")
   
10.         br(i, 1) = q & (Int(s(0)) + Int(t))
    
11.     Next i
    
12.     [b2].Resize(UBound(br), 1) = br
    
13. End Sub

复制代码