VBA加归类的字符

yjwdjfqb

VBA加归类的字符
各类老师好
如何用VBA实现如下效果，谢谢老师们了！！！

VBA加归类的字符.rar (9.2 KB, 下载次数: 9)

2024-3-14 16:32 上传

点击文件名下载附件

shiruiqiang

从后往前循环，有小计的行就提取出关键字

dragonthree

倒序循环，IF INSTR(     ，  "小计")>0 then s=replace(   ,"小计","")

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.3.14
   
2.     Dim zrr(1 To 1000)
   
3.     Application.ScreenUpdating = False
   
4.     Sheets("File").Activate
   
5.     r = Cells(Rows.Count, 3).End(3).Row
   
6.     arr = Range("c1:c" & r)
   
7.     ReDim brr(1 To UBound(arr), 0)
   
8.     On Error Resume Next
   
9.     n = 4
   
10.     For i = 4 To UBound(arr)
    
11.         If InStr(arr(i, 1), "小计") Then
    
12.             m = m + 1
    
13.             zrr(m) = Array(i, i)
    
14.             zrr(m)(1) = i
    
15.         End If
    
16.         If m = 1 Then
    
17.             zrr(m)(0) = n
    
18.         Else
    
19.             zrr(m)(0) = zrr(m - 1)(1) + 1
    
20.         End If
    
21.         If i = r Then zrr(m)(1) = r
    
22.     Next
    
23.     For x = 1 To m
    
24.         st = Replace(arr(zrr(x)(1), 1), "小计", "") & "："
    
25.         For i = zrr(x)(0) To zrr(x)(1) - 1
    
26.             Cells(i, 3) = st & Cells(i, 3)
    
27.         Next
    
28.     Next
    
29.     Application.ScreenUpdating = True
    
30.     MsgBox "OK！"
    
31. End Sub
    

复制代码

ykcbf1100

换个写法，改简单一点的。

ykcbf1100

换个简单一点的写法。

1. Sub ykcbf2()  '//2024.3.14
   
2.     Application.ScreenUpdating = False
   
3.     Sheets("File").Activate
   
4.     r = Cells(Rows.Count, 3).End(3).Row
   
5.     arr = Range("c1:c" & r)
   
6.     For i = UBound(arr) To 4 Step -1
   
7.         If InStr(arr(i, 1), "小计") Then
   
8.             st = Replace(arr(i, 1), "小计", "") & "-"
   
9.         Else
   
10.             arr(i, 1) = st & arr(i, 1)
    
11.         End If
    
12.     Next
    
13.     Range("c1:c" & r) = arr
    
14.     Application.ScreenUpdating = True
    
15.     MsgBox "OK！"
    
16. End Sub
    

复制代码

cnmlgb9998

用PQ，很简单方便！ 还能即时更新！

yjwdjfqb

ykcbf1100 发表于 2024-3-14 17:08
换个简单一点的写法。

谢谢老师的帮助，这个很好用！！！

yjwdjfqb

ykcbf1100 发表于 2024-3-14 17:08
换个简单一点的写法。

老师你好，怎么防止，已经执行了一次命令，点执行命令时，不添加这些字符喃，谢谢老师了！