能否解决一个查找的难题

青青的河边草

在表中， R列最后数不会只停留在207格，是会向下增加的，AC1到AC4是查寻标准框，点击钮（符合4个格钮），R列若有连续4个单元格内数(含顺序排序)和AC1到AC4标准框一模一样，那么R列中符合的单元格就显黄色.

静听溪流

1. Private Sub CommandButton1_Click()
   
2.     Dim i As Integer
   
3.     Dim rng As Range
   
4.     i = 1
   
5.     For Each rng In Range("r8:r" & Range("r8").End(xlDown).Row)
   
6.        If rng.Value = Cells(i, "AC").Value Then
   
7.             If i = 4 Then
   
8.                 Range(Cells(rng.Row - 3, "r"), Cells(rng.Row, "r")).Interior.ColorIndex = 6
   
9.             End If
   
10.              i = i + 1
    
11.         Else
    
12.             i = 1
    
13.         End If
    
14.     Next
    
15. End Sub
    
16. 
    
17. Private Sub CommandButton2_Click()
    
18.     Dim m As Integer
    
19.     Dim rng1 As Range
    
20.     m = 1
    
21.     For Each rng1 In Range("r8:r" & Range("r8").End(xlDown).Row)
    
22.        If rng1.Value = Cells(m, "AC").Value Then
    
23.             If m = 3 Then
    
24.                 Range(Cells(rng1.Row - 2, "r"), Cells(rng1.Row, "r")).Interior.ColorIndex = 6
    
25.             End If
    
26.              m = m + 1
    
27.         Else
    
28.             m = 1
    
29.         End If
    
30.     Next
    
31. End Sub
    

复制代码

蓝桥玄霜

查找的代码：

青青的河边草

蓝桥玄霜 发表于 2019-10-9 10:44
查找的代码：

Dim Arr, Brr, i&
Arr = [acl: ac4]
Brr = [r8].CurrentRegion
For i = UBound(Brr) To 4 Step -1
   If Brr(i, 1) = Arr(4, 1) And Brr(1 - 1, 1) = Arr(3, 1) And Brr(i - 2, 1) = Arr(2, 1) And Brr(1 - 3, 1) = Arr(1, 1) Then
    Cells(i + 4, 18).Resize(4, 1).Interior.Color Index = 6
    End If
    Next

显示错误运行13？我怎么抄错？

Jason_WangSS

1. Option Explicit
   
2. Sub test()
   
3.     Dim arr, brr(1 To 4)
   
4.     Dim i%, j%, sr1$, sr2$
   
5.     Set arr = Range(Sheet1.[r8], Sheet1.[r8].End(xlDown))
   
6.     sr1 = Join(WorksheetFunction.Transpose(Range(Sheet1.[ac1], Sheet1.[ac4])), ",")
   
7.     For i = 1 To arr.Count
   
8.         If arr(i, 1) = Sheet1.[ac1] Then
   
9.             For j = 1 To 4
   
10.                 brr(j) = arr(i + j - 1, 1)
    
11.             Next
    
12.             sr2 = Join(brr, ",")
    
13.             If sr2 = sr1 Then
    
14.                 Range(arr(i, 1), arr(i + 3, 1)).Interior.ColorIndex = 6
    
15.             End If
    
16.         End If
    
17.     Next
    
18. End Sub

复制代码

青青的河边草

错误运行13，我不知抄错在那处？\
Private Sub CommandButton1_Click()
Dim Arr, Brr, i&
Arr = [acl: ac4]
Brr = [r8].CurrentRegion
For i = UBound(Brr) To 4 Step -1
   If Brr(i, 1) = Arr(4, 1) And Brr(1 - 1, 1) = Arr(3, 1) And Brr(i - 2, 1) = Arr(2, 1) And Brr(1 - 3, 1) = Arr(1, 1) Then
    Cells(i + 4, 18).Resize(4, 1).Interior.Color Index = 6
    End If
    Next

End Sub

Jason_WangSS

青青的河边草 发表于 2019-10-9 11:42
错误运行13，我不知抄错在那处？\
Private Sub CommandButton1_Click()
Dim Arr, Brr, i&

ac1   acl？

lsdongjh

1. Private Sub CommandButton1_Click()
   
2.         Dim sh As Worksheet, rgSource As Range, rgFind As Range
   
3.         Dim lngCount As Long
   
4.         
   
5.         Set sh = Sheets("Sheet1")
   
6.         Set rgSource = sh.Range("R8")
   
7.         Set rgFind = sh.Range("AC1")
   
8.         lngCount = 4
   
9.                
   
10.          MsgBox "符合【" & lngCount & "】个格条件的" & vbCrLf & "共找到【" & FindAndColor(rgSource, rgFind, lngCount) & "】处匹配区域"
    
11.         
    
12. End Sub
    
13. 
    
14. 
    
15. Function FindAndColor(rgSourceStart As Range, rgFindStart As Range, lngStep As Long) As Long
    
16.     Dim rgSource As Range, rgFind As Range, lngRows As Long, lngStart As Long
    
17.     Dim lngRow As Long, lngID As Long, blIsFind As Boolean, lngCount As Long
    
18.    
    
19.     lngRows = rgSourceStart.End(xlDown).Row
    
20.     lngStart = rgSourceStart.Row
    
21.    
    
22.     Set rgFind = rgFindStart.Resize(lngStep, 1)
    
23.    
    
24.     For lngRow = lngStart To lngRows - lngStep + 1
    
25.             Set rgSource = rgSourceStart.Resize(lngStep, 1)
    
26.             rgSource.Interior.ColorIndex = 0
    
27.             blIsFind = True
    
28.             For lngID = 1 To lngStep
    
29.                 If rgSource(lngID) <> rgFind(lngID) Then
    
30.                     blIsFind = False
    
31.                     Exit For
    
32.                 End If
    
33.             Next
    
34.             If blIsFind Then
    
35.                 rgSource.Interior.ColorIndex = 6
    
36.                 Set rgSourceStart = rgSourceStart.Offset(lngStep, 0)
    
37.                 lngCount = lngCount + 1
    
38.                 lngRow = lngRow + lngStep - 1
    
39.             Else
    
40.                 Set rgSourceStart = rgSourceStart.Offset(1, 0)
    
41.             End If
    
42.     Next
    
43.    
    
44.     FindAndColor = lngCount
    
45. End Function

复制代码

青青的河边草

Jason_WangSS 发表于 2019-10-9 11:31

忘了说，r列的数字不一定是从r8开始。

Jason_WangSS

青青的河边草 发表于 2019-10-9 13:20
忘了说，r列的数字不一定是从r8开始。

那你自己改改，代码都给了