大佬们好久不见，能否帮忙

Mr_Ying

大家下午好！
功能简单说一下，当在B3:E6输入数字，按钮1，可分列数字和产生红色大写。


1.以上代码是AI出来的，我想简化一下
2.在红色框加上羊角符号，这个位置是动态

shiruiqiang

循环判断g-o列，不为空，offset(0,-1)就添加符号

蓝桥玄霜

分列的例子：

Qs18

1. Sub qs()
   
2. With Sheet6
   
3. 
   
4. For r = 3 To 6
   
5.     x2 = x2 + Application.WorksheetFunction.Round(.Range("b" & r).Value * 100, 0)
   
6.    
   
7.     x = "￥" & Application.WorksheetFunction.Round(.Range("b" & r).Value * 100, 0)
   
8.    
   
9.     For i = 1 To Len(x)
   
10.          .Cells(r, 16 - i).Value = Left(Right(x, i), 1)
    
11.     Next
    
12. Next
    
13. 'a = [{18,16,14,12,10,8,6,4,2}]
    
14. 'For y = 1 To Len(x2)
    
15. '    c = c + 1
    
16. '    .Cells(10, a(c)).Value = zdxa(Left(Right(x2, y), 1))
    
17. 'Next
    
18. '
    
19. x2 = "￥" & x2
    
20.     For i = 1 To Len(x2)
    
21.          .Cells(7, 16 - i).Value = Left(Right(x2, i), 1)
    
22.     Next
    
23. End With
    
24. End Sub

复制代码

Qs18

试试...........

Qs18

这个"ⓧ"在我这个vba里面是个问号

Qs18

试试.........

Qs18

试试................

Qs18

1. Sub qs()
   
2. With Sheet6
   
3. 
   
4. For r = 3 To 6
   
5.     x2 = x2 + Application.WorksheetFunction.Round(.Range("b" & r).Value * 100, 0)
   
6.    
   
7.     x = "￥" & Application.WorksheetFunction.Round(.Range("b" & r).Value * 100, 0)
   
8.    
   
9.     For i = 1 To Len(x)
   
10.          .Cells(r, 16 - i).Value = Left(Right(x, i), 1)
    
11.     Next
    
12. Next
    
13. a = [{18,16,14,12,10,8,6,4,2}]
    
14. For y = 1 To Len(x2)
    
15.     c = c + 1
    
16.     .Cells(8, a(c)).Value = zdxa(Left(Right(x2, y), 1))
    
17. Next
    
18. For i = c + 1 To UBound(a)
    
19.     .Cells(8, a(i)).Value = ChrW(&H2717)
    
20. Next
    
21. x2 = "￥" & x2
    
22.     For i = 1 To Len(x2)
    
23.          .Cells(7, 16 - i).Value = Left(Right(x2, i), 1)
    
24.     Next
    
25. End With
    
26. End Sub
    
27. Function zdxa(x) '升级转数字人民币大写
    
28. Dim a
    
29. a = [{0,"零";1,"壹";2,"贰";3,"叁";4,"肆";5,"伍";6,"陆";7,"柒";8,"捌";9,"玖"}]
    
30. Set dic = CreateObject("scripting.dictionary")
    
31.     For i = 1 To UBound(a)
    
32.     dic(CStr(a(i, 1))) = a(i, 2)
    
33.     dic(a(i, 1)) = a(i, 2)
    
34.     Next
    
35. If dic.exists(x) Then
    
36.     zdxa = dic(x)
    
37. Else
    
38.     zdxa = x
    
39. End If
    
40. Set dic = Nothing
    
41. End Function

复制代码

Mr_Ying

Qs18 发表于 2024-11-19 17:31

你好，谢谢你，读取数据是F3到F7的位置,F3=SUM(B3:E3),依次类推
如果能在B3:E6,输入，触发整个程序就更完美了，包含小计计算