各位老师好！VBA可不可以有这个效果.比较复杂，请老师们看看。谢谢！！

joy.008@163.com

代码审核中 上传附件测试一下先

joy.008@163.com

1. Sub joy20240902ss()
   
2. 
   
3. Dim arr, brr, ra%, rb%, cb%, i%, j%, AL%
   
4. On Error Resume Next
   
5. Application.ScreenUpdating = False
   
6. ra = Cells(Rows.Count, 140).End(3).Row
   
7. cb = Cells(1, 267).End(2).Column - 267 + 1
   
8. arr = [EJ1].Resize(ra, 126)
   
9. brr = [JG1].Resize(ra, cb)
   
10. For i = 6 To ra
    
11. For j = 1 To cb
    
12.     AL = Int((j - 1) / 10 + 1)
    
13.     If i < brr(3, j) + 2 Then GoTo 100
    
14.     If arr(i, AL) = brr(2, j) And arr(i, AL) = arr(i - brr(3, j) - 1, AL) Then brr(i, j) = 11
    
15. Next
    
16. 100:
    
17. Next
    
18. [JG1].Resize(ra, cb) = brr
    
19. Application.ScreenUpdating = True
    
20. End Sub

复制代码

joy.008@163.com

Sub joy20240902ss()

Dim arr, brr, ra%, rb%, cb%, i%, j%, AL%
On Error Resume Next
Application.ScreenUpdating = False
ra = Cells(Rows.Count, 140).End(3).Row
cb = Cells(1, 267).End(2).Column - 267 + 1
arr = [EJ1].Resize(ra, 126)
brr = [JG1].Resize(ra, cb)
For i = 6 To ra
For j = 1 To cb
    AL = Int((j - 1) / 10 + 1)
    If i < brr(3, j) + 2 Then GoTo 100
    If arr(i, AL) = brr(2, j) And arr(i, AL) = arr(i - brr(3, j) - 1, AL) Then brr(i, j) = 11
Next
100:
Next
[JG1].Resize(ra, cb) = brr
Application.ScreenUpdating = True
End Sub

13602822168

joy.008@163.com 发表于 2024-9-2 22:04
代码审核中 上传附件测试一下先

厉害！！！！！！前面数据源有126列要改哪里？
另一个问题：另外如果删除一个条件不要间隔，只检测数值，跟数值同一行标记11就可以了，应该怎么改。谢谢！！！！

joy.008@163.com

13602822168 发表于 2024-9-2 22:28
厉害！！！！！！前面数据源有126列要改哪里？
另一个问题：另外如果删除一个条件不要间隔，只检测数值 ...

前面数据源有126列要改哪里？
答:已经定义arr数组为126列
另外如果删除一个条件不要间隔，只检测数值
答:那你就把间隔改为-1 如果是上下紧挨着 就设置为0 依此类推

13602822168

joy.008@163.com 发表于 2024-9-3 00:44
前面数据源有126列要改哪里？
答:已经定义arr数组为126列
另外如果删除一个条件不要间隔，只检测数值
...

您好！！如果想显示位置全部都向下移动5行，要怎么改。谢谢！！

joy.008@163.com

如果想显示位置全部都向下移动5行，要怎么改
If arr(i, AL) = brr(2, j) And arr(i, AL) = arr(i - brr(3, j) - 1, AL) Then brr(i, j) = 11
改为
If arr(i, AL) = brr(2, j) And arr(i, AL) = arr(i - brr(3, j) - 1, AL) Then brr(i+5, j) = 11
另外 brr数组要增加5行 否则会有匹配到显示不了的情况
brr = [JG1].Resize(ra, cb)
改为
brr = [JG1].Resize(ra+5, cb)
********
[JG1].Resize(ra, cb) = brr
改为
[JG1].Resize(ra+5, cb) = brr

13602822168

joy.008@163.com 发表于 2024-9-3 13:37
如果想显示位置全部都向下移动5行，要怎么改
If arr(i, AL) = brr(2, j) And arr(i, AL) = arr(i - brr(3, ...

谢谢你！！！！！有空帮忙看看这个。
各位老师好！VBA归类或者复制应该怎么写，请各位老师抽空看看，谢谢！！
https://club.excelhome.net/thread-1700885-1-1.html
(出处: ExcelHome技术论坛)

13602822168

joy.008@163.com 发表于 2024-9-3 13:37
如果想显示位置全部都向下移动5行，要怎么改
If arr(i, AL) = brr(2, j) And arr(i, AL) = arr(i - brr(3, ...

谢谢！！我想错了，也表达错了，可能还复杂一点，是根据间隔的行数从后向上5行，也就是在原来显示的位置，例如本来是在F10显示的，间隔是10，就在F10位置向下数10行，即在F21显示（但要减5行）最终在F16显示。
又或者这样：间隔数是8的，向下3行，间隔数是9的，向下4行，间隔数是10的，向下5行，间隔数是11的，向下6行，间隔数是12的，向下7行，间隔数是13的，向下8行，，，，，，这样会不会太复杂。谢谢！！