表格的形式变了，要如何改写代码？请求老师帮忙。

小绿草

表格的形式变了，要如何改写代码？请求老师帮忙。详见附件中的表格和说明。

小绿草

请老师们帮忙。

Jun8095

Public Sub 红()
Dim bj, kb
Dim bs As Range
Dim i, j, k As Integer
    For Each bs In Range("b6:ao23")
        If bs.Interior.Color = 255 Then bs.Interior.PatternColor = xlNone
    Next
kb = Range("b6:ao23")
bj = Range("BI3:BZ3")
    For i = 2 To UBound(bj, 2)
        If bj(1, i) <> 0 Then
            For j = 1 To UBound(kb, 2)
                If kb(bj(1, i), j) = bj(1, 1) Then Cells(bj(1, i) + 5, j + 1).Interior.Color = 255: k = k + 1
            Next
        End If
    Next
    Cells(4, "bl") = k
End Sub

Public Sub 黄()
Dim bj, kb
Dim bs As Range
Dim i, j, k As Integer
    For Each bs In Range("b6:ao23")
        If bs.Interior.Color = 65535 Then bs.Interior.PatternColor = xlNone
    Next
kb = Range("b6:ao23")
bj = Range("BI9:BZ9")
    For i = 2 To UBound(bj, 2)
        If bj(1, i) <> 0 Then
            For j = 1 To UBound(kb, 2)
                If kb(bj(1, i), j) = bj(1, 1) Then Cells(bj(1, i) + 5, j + 1).Interior.Color = 65535: k = k + 1
            Next
        End If
    Next
    Cells(10, "bl") = k
End Sub

Public Sub 绿()
Dim bj, kb
Dim bs As Range
Dim i, j, k As Integer
    For Each bs In Range("b6:ao23")
        If bs.Interior.Color = 5287936 Then bs.Interior.PatternColor = xlNone
    Next
kb = Range("b6:ao23")
bj = Range("BI15:BZ15")
    For i = 2 To UBound(bj, 2)
        If bj(1, i) <> 0 Then
            For j = 1 To UBound(kb, 2)
                If kb(bj(1, i), j) = bj(1, 1) Then Cells(bj(1, i) + 5, j + 1).Interior.Color = 5287936: k = k + 1
            Next
        End If
    Next
    Cells(16, "bl") = k
End Sub

Jun8095

三个按钮代码分开

小绿草

Jun8095 发表于 2018-8-15 22:18
三个按钮代码分开

是的。。。。。。。。

iwangyi

二手活做起来不顺手，有强迫症感觉，楼主要耐心等。

Jun8095

Public Sub 红()
Dim bj, kb
Dim bs As Range
Dim i, j, k As Integer
    For Each bs In Range("b6:ao23")
        If bs.Interior.Color = 255 Then bs.Interior.PatternColor = xlNone
    Next
kb = Range("b6:ao23")
bj = Range("BI3:BZ3")
    For i = 2 To UBound(bj, 2)
        If bj(1, i) <> 0 Then
            For j = 1 To UBound(kb, 2)
                If kb(bj(1, i), j) = bj(1, 1) Then Cells(bj(1, i) + 5, j + 1).Interior.Color = 255: k = k + 1
            Next
        End If
    Next
    Cells(4, "bl") = k
End Sub

Jun8095

Public Sub 红()
Dim bj, kb
Dim bs As Range
Dim i, j, k As Integer
    For Each bs In Range("b6:ao23")
        If bs.Interior.Color = 255 Then bs.Interior.PatternColor = xlNone
    Next
kb = Range("b6:ao23")
bj = Range("BI3:BZ3")
    For i = 2 To UBound(bj, 2)
        If bj(1, i) <> 0 Then
            For j = 1 To UBound(kb, 2)
                If kb(bj(1, i), j) = bj(1, 1) Then Cells(bj(1, i) + 5, j + 1).Interior.Color = 255: k = k + 1
            Next
        End If
    Next
    Cells(4, "bl") = k
End Sub

小绿草

iwangyi 发表于 2018-8-15 22:26
二手活做起来不顺手，有强迫症感觉，楼主要耐心等。

谢谢您。。。。。。。。

Jun8095

1. Public Sub 红()
   
2. Dim bj, kb
   
3. Dim bs As Range
   
4. Dim i, j, k As Integer
   
5.     For Each bs In Range("b6:ao23")
   
6.         If bs.Interior.Color = 255 Then bs.Interior.PatternColor = xlNone
   
7.     Next
   
8. kb = Range("b6:ao23")
   
9. bj = Range("BI3:BZ3")
   
10.     For i = 2 To UBound(bj, 2)
    
11.         If bj(1, i) <> 0 Then
    
12.             For j = 1 To UBound(kb, 2)
    
13.                 If kb(bj(1, i), j) = bj(1, 1) Then Cells(bj(1, i) + 5, j + 1).Interior.Color = 255: k = k + 1
    
14.             Next
    
15.         End If
    
16.     Next
    
17.     Cells(4, "bl") = k
    
18. End Sub

复制代码