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

Jun8095

。。。。。

YZC51

学习各位老师到代码，谢谢！请参考
Sub cxhongse()
Call weimss(Sheet2.Range("bi3:bz3"), 255, 1)
End Sub

Sub cxhuangse()
Call weimss(Sheet2.Range("bi9:br9"), 65535, 2)
End Sub

Sub cxlvse()
Call weimss(Sheet2.Range("bi15:br15"), 5287936, 3)
End Sub

Sub qchu()
    Sheet2.Range("B6:AN23").Interior.ColorIndex = 0
End Sub
Sub weimss(bjj As Range, ys, jss) '***
Dim i, j, k As Integer
Dim bj, kb
k = 0
kb = Range("B6:AM23")
    For Each bs In Range("B6:AM23")
        If bs.Interior.Color = ys Then bs.Interior.PatternColor = xlNone
    Next
bj = bjj
    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 = ys: k = k + 1
            Next
        End If
    Next
    Choose(jss, Sheet2.[BL4], Sheet2.[BL10], Sheet2.[BL16]) = k
End Sub

YZC51

请参考
原表和新表.rar (52.25 KB, 下载次数: 3)

2018-8-16 11:32 上传

点击文件名下载附件

小绿草

Jun8095 发表于 2018-8-15 23:40
。。。。。

老师，谢谢您！
     还有个需求我原先没说清楚，就是：第二次再用某按钮查询时要把第一次填的色清掉（也就是要还原为无色）。例：用“查询（红）”按钮查到A老师的课都填红色了，再用该按钮查B老师的课时，要先把A老师的原红色课变为无色，（但同时要注意别把黄色和绿色也变为无色，）再为B老师的课填红色。其他的两个按钮也要这样。
        恳请您再帮忙修改一下，谢谢

Jun8095

小绿草 发表于 2018-8-16 12:37
老师，谢谢您！
     还有个需求我原先没说清楚，就是：第二次再用某按钮查询时要把第一次填的色清掉（ ...

是按照你的要求啊，换老师的时候，原颜色清掉了，麻烦按我发的附件再试一下

小绿草

老师，谢谢您！
    我想三个按钮一起使用，但我不会代码，恳请您帮忙。
要注意第二次再用某按钮查询时要把第一次填的色清掉（也就是要还原为无色）。（例见上面）

Jun8095

小绿草 发表于 2018-8-16 13:03
老师，谢谢您！
    我想三个按钮一起使用，但我不会代码，恳请您帮忙。
要注意第二次再用某按钮查询时要 ...

抱歉，我确定是按照你的要求写的，回复附件在11楼，只有一个新表那个，麻烦再看一下

Jun8095

小绿草 发表于 2018-8-16 13:03
老师，谢谢您！
    我想三个按钮一起使用，但我不会代码，恳请您帮忙。
要注意第二次再用某按钮查询时要 ...

或者3楼代码，按 红、黄、绿 三段代码分别放在三个按钮上

lsdongjh

1. Option Explicit
   
2. 
   
3. Dim rgRed As Range, rgYellow As Range, rgGreen As Range
   
4. Dim arrTemp As Variant
   
5. 
   
6. '红色
   
7. Sub FindRed()
   
8.     arrTemp = Sheets("高一课程表").Range("BI3:BR3")
   
9.     Set rgRed = Nothing
   
10.     FindReturnRange arrTemp, rgRed
    
11. End Sub
    
12. 
    
13. '黄色
    
14. Sub FindYellow()
    
15.     arrTemp = Sheets("高一课程表").Range("BI9:BR9")
    
16.     Set rgYellow = Nothing
    
17.     FindReturnRange arrTemp, rgYellow
    
18. End Sub
    
19. 
    
20. '绿色
    
21. Sub FindGreen()
    
22.     arrTemp = Sheets("高一课程表").Range("BI15:BR15")
    
23.     Set rgGreen = Nothing
    
24.     FindReturnRange arrTemp, rgGreen
    
25. End Sub
    
26. 
    
27. '查找、设置过程
    
28. Function FindReturnRange(arrCondition As Variant, rgReturn As Range)
    
29.     Dim shSource As Worksheet
    
30.     Dim arr As Variant
    
31.     Dim strFind As String, lngRowID(1 To 9) As Long
    
32.     Dim lngRow As Long, lngCol As Long
    
33.     Dim rgTemp As Range
    
34.    
    
35.     Set shSource = Sheets("高一课程表")
    
36.    
    
37.     strFind = arrCondition(1, 1)
    
38.     For lngRow = 1 To 9
    
39.         lngRowID(lngRow) = arrCondition(1, lngRow + 1)
    
40.     Next
    
41.    
    
42.     arr = shSource.Range("B6:AO23")
    
43.    
    
44.     For lngRow = 1 To 9
    
45.         If lngRowID(lngRow) > 0 Then
    
46.             For lngCol = 1 To UBound(arr)
    
47.                 If arr(lngRowID(lngRow), lngCol) = strFind Then
    
48.                     If rgTemp Is Nothing Then
    
49.                         Set rgTemp = shSource.Cells(lngRowID(lngRow) + 5, lngCol + 1)
    
50.                     Else
    
51.                         Set rgTemp = Union(rgTemp, shSource.Cells(lngRowID(lngRow) + 5, lngCol + 1))
    
52.                     End If
    
53.                 End If
    
54.             Next
    
55.         End If
    
56.     Next
    
57.    
    
58.     If rgTemp Is Nothing Then
    
59.         FindReturnRange = False
    
60.     Else
    
61.         Set rgReturn = rgTemp
    
62.         FindReturnRange = True
    
63.     End If
    
64.    
    
65.     shSource.Range("B6:AO23").Interior.ColorIndex = 0
    
66.     If Not rgRed Is Nothing Then rgRed.Interior.ColorIndex = 3
    
67.     If Not rgGreen Is Nothing Then rgGreen.Interior.ColorIndex = 10
    
68.     If Not rgYellow Is Nothing Then rgYellow.Interior.ColorIndex = 6
    
69. End Function
    
70. 
    
71. 
    

复制代码

lsdongjh

代码审核中，见附件： 新表.rar (29.18 KB, 下载次数: 8)

2018-8-16 13:44 上传

点击文件名下载附件