数字的球形填充

yhy95331

在网上目前没发现数字球形填充代码，只有用了个替代法完成，看大师们有办法直接将数字球形填充，谢谢!!

ykcbf1100

没看懂规则。

yhy95331

数字外加球形填充色 ，己给代码示范了

yhy95331

只想来点直接填充，优化一下

LIUZHU

不知道规律什么，楼主不如自己总结下

ww87725244

1. Sub 转换()
   
2. Dim s, rng As Range
   
3. s = "6789ABCDE"
   
4. With Sheet3
   
5.     For Each rng In .Range(.Cells(1, 1), .Cells(10, 5))
   
6.         If rng.Value <> "" Then
   
7.             If rng.Value <> 0 Then
   
8.                  rng.Value = ChrW("&H277" & Mid(s, rng.Value, 1))
   
9.             Else
   
10.                  rng.Value = ChrW(&H24FF)
    
11.             End If
    
12.         End If
    
13.     Next
    
14. End With
    
15. End Sub

复制代码

ww87725244

1. Sub 还原()
   
2. Dim rng As Range
   
3. With Sheet3
   
4.     For Each rng In .Range(.Cells(1, 1), .Cells(10, 5))
   
5.         If rng.Value <> "" Then
   
6.             If CInt(AscW(rng.Text)) = CInt(9471) Then
   
7.                 rng.Value = CInt(AscW(rng.Text)) - CInt(9471)
   
8.             Else
   
9.                 rng.Value = CInt(AscW(rng.Text)) - CInt(10101)
   
10.             End If
    
11.         End If
    
12.     Next
    
13. End With
    
14. End Sub

复制代码

yhy95331

图一变图二

cidanji

1. Sub test()
   
2. [A1] = 转球(12345)
   
3. End Sub
   
4. 
   
5. Function 转球(num)
   
6. Dim s$, ss$, n&, i&
   
7. For i = 1 To Len(num)
   
8.     s = Mid(num, i, 1)
   
9.     If IsNumeric(s) Then s = ChrW(IIf(s = "0", 9471, 10101 + s))
   
10.     ss = ss & s
    
11. Next
    
12. 转球 = ss
    
13. End Function

复制代码

yhy95331

ww87725244 发表于 2024-5-29 18:23

谢谢大师，代码简洁不少