[已解决]如何根据单元格颜色为判断条件进行运算？

ysrr2011

A列是一列按大小顺序排列好的数组，部分单元格是黄色的，
需要将所有黄色单元格两边的数值差计算出来放在B列，
如有连续的黄色单元格需要看成一个整体，如附件所示：
比如A2,A3,A4,均为黄色，需要计算的值是A5-A1,并放在对应的B2,B3,B4内，
请问如何编写程序？

最佳答案

月排行榜 / 总排行榜

dsmch

2014-8-30 19:30

ysrr2011 发表于 2014-8-30 11:45
谢谢，但如果需要同时对其他列进行相同处理该怎么办，其实共有A、D、G、F、4列要处理。

1. Sub Macro1()
   
2. Dim i&, j&, k&, n&, x&, y&
   
3. For m = 1 To 10 Step 3
   
4. n = Cells(Rows.Count, m).End(xlUp).Row - 1
   
5. For i = 2 To n
   
6. If Cells(i, m).Interior.ColorIndex = 6 Then
   
7. For j = i - 1 To 1 Step -1
   
8. If Cells(j, m).Interior.ColorIndex = xlNone Then x = j: Exit For
   
9. Next
   
10. For k = i + 1 To n + 1
    
11. If Cells(k, m).Interior.ColorIndex = xlNone Then y = k: Exit For
    
12. Next
    
13. Cells(i, m + 1) = Cells(y, m) - Cells(x, m)
    
14. End If
    
15. Next
    
16. Next
    
17. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim i&, j&, k&, n&, x&, y&
   
3. n = Cells(Rows.Count, 1).End(xlUp).Row - 1
   
4. For i = 2 To n
   
5.     If Cells(i, 1).Interior.ColorIndex = 6 Then
   
6.         For j = i - 1 To 1 Step -1
   
7.             If Cells(j, 1).Interior.ColorIndex = xlNone Then x = j: Exit For
   
8.         Next
   
9.         For k = i + 1 To n + 1
   
10.             If Cells(k, 1).Interior.ColorIndex = xlNone Then y = k: Exit For
    
11.         Next
    
12.         Cells(i, 3) = Cells(y, 1) - Cells(x, 1)
    
13.     End If
    
14. Next
    
15. End Sub

复制代码

dsmch

………………

yangyangzhifeng

要是A1为黄色，要怎么算？

ysrr2011

yangyangzhifeng 发表于 2014-8-30 10:57
要是A1为黄色，要怎么算？

A1为0，A170为21000，为额外添加的，不为黄色。

ysrr2011

dsmch 发表于 2014-8-30 04:12

谢谢，但如果需要同时对其他列进行相同处理该怎么办，其实共有A、D、G、F、4列要处理。

yangyangzhifeng

ysrr2011 发表于 2014-8-30 11:45
谢谢，但如果需要同时对其他列进行相同处理该怎么办，其实共有A、D、G、F、4列要处理。

试试看

1. Sub test()    Dim ar(), br(), i&, j&, r&
   
2.     Dim k&, l&, m&, n&
   
3.     For j = 1 To 10 Step 3
   
4.         r = Cells(Rows.Count, j).End(3).Row
   
5.         ReDim ar(1 To r, 1 To 1)
   
6.         ReDim br(1 To r, 1 To 1)
   
7.         For i = 1 To r
   
8.             If Cells(i, j).Interior.ColorIndex <> 6 Then
   
9.                 ar(i, 1) = Cells(i, j)
   
10.             End If
    
11.         Next
    
12.         For n = 1 To r
    
13.             For k = n To r
    
14.                 If ar(k, 1) = "" Then
    
15.                     Exit For
    
16.                 End If
    
17.             Next
    
18.             For l = k To r
    
19.                 If ar(l, 1) <> "" Then
    
20.                     n = l
    
21.                     Exit For
    
22.                 End If
    
23.             Next
    
24.             For m = k To l - 1
    
25.                 br(m, 1) = ar(l, 1) - ar(k - 1, 1)
    
26.             Next
    
27.         Next
    
28.         Cells(1, j + 1).Resize(r, 1) = br
    
29.     Next
    
30. End Sub

复制代码

dsmch

ysrr2011 发表于 2014-8-30 11:45
谢谢，但如果需要同时对其他列进行相同处理该怎么办，其实共有A、D、G、F、4列要处理。

1. Sub Macro1()
   
2. Dim i&, j&, k&, n&, x&, y&
   
3. For m = 1 To 10 Step 3
   
4. n = Cells(Rows.Count, m).End(xlUp).Row - 1
   
5. For i = 2 To n
   
6. If Cells(i, m).Interior.ColorIndex = 6 Then
   
7. For j = i - 1 To 1 Step -1
   
8. If Cells(j, m).Interior.ColorIndex = xlNone Then x = j: Exit For
   
9. Next
   
10. For k = i + 1 To n + 1
    
11. If Cells(k, m).Interior.ColorIndex = xlNone Then y = k: Exit For
    
12. Next
    
13. Cells(i, m + 1) = Cells(y, m) - Cells(x, m)
    
14. End If
    
15. Next
    
16. Next
    
17. End Sub

复制代码