如何添加数字颜色（传不上附件重发一贴）

yynrzwh

yynrzwh

达州张先生

yynrzwh 发表于 2025-12-5 23:07

你好，这种形状的不好，可不要，要三个数顶点在9宫格和4宫格、16宫格的构成正直角、等边三角形形状的，右边这种斜形状的必要，可以吗？多谢了

达州张先生

yynrzwh 发表于 2025-12-5 23:07

这种斜的三角形形状不要，谢谢

达州张先生

lxdexcel 发表于 2025-12-4 20:03

你好，下面图片这种形式的正三角形（等边、直角等腰）应该计入，谢谢帮忙了

达州张先生

lxdexcel 发表于 2025-12-4 20:03

下面这种形式的正正三角形（直角、等边）应记入颜色，谢谢帮忙了

lxdexcel

1. Option Explicit
   
2. 
   
3. Private Sub CommandButton1_Click()
   
4. Dim r&, c&, r1&, c1&, r2&, c2&, i&
   
5. Dim m1&, m2&, m3&, m&()
   
6. Dim n&, n1&, n2&
   
7. Dim ms As String
   
8. Dim dr As Variant
   
9. Dim dc As Variant
   
10. 
    
11. 
    
12. For c = 2 To 14 '还原黑色
    
13.     For r = 3 To 19
    
14.        Cells(r, c).Font.ColorIndex = 0
    
15.     Next
    
16. Next
    
17. 
    
18. '取得数值
    
19. ms = Range("q2").Value
    
20. m1 = Val(Mid(ms, 1, 1))
    
21. m2 = Val(Mid(ms, 2, 1))
    
22. m3 = Val(Mid(ms, 3, 1))
    
23. 
    
24. ReDim m(0 To 9)
    
25. m(m1) = 1
    
26. m(m2) = m(m2) + 1
    
27. m(m3) = m(m3) + 1
    
28. '行列增加值
    
29. dr = Array(0, 1, 0, -1)
    
30. dc = Array(1, 0, -1, 0)
    
31. '循环
    
32. For c = 2 To 14
    
33.     For r = 3 To 19
    
34.       
    
35.        n = Cells(r, c)
    
36.        If m(n) <> 0 Then 'n为其中一个数
    
37.           m(n) = m(n) - 1
    
38.           r2 = r + dr(3)
    
39.           c2 = c + dc(3)
    
40.           For i = 0 To 3
    
41.               r1 = r2
    
42.               c1 = c2
    
43.               r2 = r + dr(i)
    
44.               c2 = c + dc(i)
    
45.               If r1 >= 3 And r1 <= 19 And c1 >= 2 And c1 <= 14 And _
    
46.                  r2 >= 3 And r2 <= 19 And c2 >= 2 And c2 <= 14 Then '是否超范围
    
47.                  
    
48.                     n1 = Cells(r1, c1)
    
49.                     n2 = Cells(r2, c2)
    
50.                     '是否符合条件
    
51.                     If m(n1) <> 0 Then 'n1为其中一个数
    
52.                         m(n1) = m(n1) - 1
    
53.                         If m(n2) <> 0 Then 'n2为其中一个数
    
54.                           
    
55.                           Cells(r, c).Font.ColorIndex = 3
    
56.                           Cells(r1, c1).Font.ColorIndex = 3
    
57.                           Cells(r2, c2).Font.ColorIndex = 3
    
58.                         
    
59.                           m(n2) = 1
    
60.                           
    
61.                         End If
    
62.                         m(n1) = m(n1) + 1
    
63.                     End If
    
64.                End If
    
65.            Next
    
66.        m(n) = m(n) + 1
    
67.        End If
    
68.       
    
69.      Next
    
70.   Next
    
71. End Sub
    
72. 
    
73. Private Sub CommandButton2_Click()
    
74. Dim r&, c&, r1&, c1&, r2&, c2&, i&
    
75. Dim m1&, m2&, m3&, m&()
    
76. Dim n&, n1&, n2&
    
77. Dim ms As String
    
78. Dim dr As Variant
    
79. Dim dc As Variant
    
80. 
    
81. 
    
82. For c = 2 To 14 '还原黑色
    
83.     For r = 3 To 19
    
84.        Cells(r, c).Font.ColorIndex = 0
    
85.     Next
    
86. Next
    
87. 
    
88. '取得数值
    
89. ms = Range("q2").Value
    
90. m1 = Val(Mid(ms, 1, 1))
    
91. m2 = Val(Mid(ms, 2, 1))
    
92. m3 = Val(Mid(ms, 3, 1))
    
93. 
    
94. ReDim m(0 To 9)
    
95. m(m1) = 1
    
96. m(m2) = m(m2) + 1
    
97. m(m3) = m(m3) + 1
    
98. '行列增加值
    
99. dr = Array(0, 2, 0, -2)
    
100. dc = Array(2, 0, -2, 0)
     
101. '循环
     
102. For c = 2 To 14
     
103.     For r = 3 To 19
     
104.       
     
105.        n = Cells(r, c)
     
106.        If m(n) <> 0 Then 'n为其中一个数
     
107.           m(n) = m(n) - 1
     
108.           r2 = r + dr(3)
     
109.           c2 = c + dc(3)
     
110.           For i = 0 To 3
     
111.               r1 = r2
     
112.               c1 = c2
     
113.               r2 = r + dr(i)
     
114.               c2 = c + dc(i)
     
115.               If r1 >= 3 And r1 <= 19 And c1 >= 2 And c1 <= 14 And _
     
116.                  r2 >= 3 And r2 <= 19 And c2 >= 2 And c2 <= 14 Then '是否超范围
     
117.                  
     
118.                     n1 = Cells(r1, c1)
     
119.                     n2 = Cells(r2, c2)
     
120.                     '是否符合条件
     
121.                     If m(n1) <> 0 Then 'n1为其中一个数
     
122.                         m(n1) = m(n1) - 1
     
123.                         If m(n2) <> 0 Then 'n2为其中一个数
     
124.                           
     
125.                           Cells(r, c).Font.ColorIndex = 4
     
126.                           Cells(r1, c1).Font.ColorIndex = 4
     
127.                           Cells(r2, c2).Font.ColorIndex = 4
     
128.                         
     
129.                           m(n2) = 1
     
130.                           
     
131.                         End If
     
132.                         m(n1) = m(n1) + 1
     
133.                     End If
     
134.                End If
     
135.            Next
     
136.        m(n) = m(n) + 1
     
137.        End If
     
138.       
     
139.      Next
     
140.   Next
     
141. End Sub
     
142. 
     
143. Private Sub CommandButton3_Click()
     
144. Dim r&, c&, r1&, c1&, r2&, c2&, i&, k&
     
145. Dim m1&, m2&, m3&, m&()
     
146. Dim n&, n1&, n2&
     
147. Dim ms As String
     
148. Dim dr As Variant
     
149. Dim dc As Variant
     
150. 
     
151. 
     
152. For c = 2 To 14 '还原黑色
     
153.     For r = 3 To 19
     
154.        Cells(r, c).Font.ColorIndex = 0
     
155.     Next
     
156. Next
     
157. 
     
158. '取得数值
     
159. ms = Range("q2").Value
     
160. m1 = Val(Mid(ms, 1, 1))
     
161. m2 = Val(Mid(ms, 2, 1))
     
162. m3 = Val(Mid(ms, 3, 1))
     
163. 
     
164. ReDim m(0 To 9)
     
165. m(m1) = 1
     
166. m(m2) = m(m2) + 1
     
167. m(m3) = m(m3) + 1
     
168. '行列增加值
     
169. dr = Array(2, 2, -2, -2, 1, -1, 1, -1)
     
170. dc = Array(1, -1, 1, -1, 2, 2, -2, -2)
     
171. '循环
     
172. For c = 2 To 14
     
173.     For r = 3 To 19
     
174.       
     
175.        n = Cells(r, c)
     
176.        If m(n) <> 0 Then 'n为其中一个数
     
177.           m(n) = m(n) - 1
     
178.          
     
179.           For i = 0 To 3
     
180.               k = i * 2
     
181.               r1 = r + dr(k)
     
182.               c1 = c + dc(k)
     
183.               r2 = r + dr(k + 1)
     
184.               c2 = c + dc(k + 1)
     
185.               If r1 >= 3 And r1 <= 19 And c1 >= 2 And c1 <= 14 And _
     
186.                  r2 >= 3 And r2 <= 19 And c2 >= 2 And c2 <= 14 Then '是否超范围
     
187.                  
     
188.                     n1 = Cells(r1, c1)
     
189.                     n2 = Cells(r2, c2)
     
190.                     '是否符合条件
     
191.                     If m(n1) <> 0 Then 'n1为其中一个数
     
192.                         m(n1) = m(n1) - 1
     
193.                         If m(n2) <> 0 Then 'n2为其中一个数
     
194.                           
     
195.                           Cells(r, c).Font.ColorIndex = 5
     
196.                           Cells(r1, c1).Font.ColorIndex = 5
     
197.                           Cells(r2, c2).Font.ColorIndex = 5
     
198.                         
     
199.                           m(n2) = 1
     
200.                           
     
201.                         End If
     
202.                         m(n1) = m(n1) + 1
     
203.                     End If
     
204.                End If
     
205.            Next
     
206.        m(n) = m(n) + 1
     
207.        End If
     
208.       
     
209.      Next
     
210.   Next
     
211. End Sub
     

复制代码

如何改变字体颜色.rar (21.27 KB, 下载次数: 4)

2025-12-7 15:35 上传

点击文件名下载附件

达州张先生

lxdexcel 发表于 2025-12-7 15:35

好复杂，能合并到一个程序里吗？一次选完并给字体加上红色，多谢了！

达州张先生

lxdexcel 发表于 2025-12-7 15:35

请问：第三个按钮程序是干什么的？好像没实用性呀，谢谢！

赵桢0611

点击P2-P4单元格，