模糊查询后合并单元格

暗夜央

D列模糊查询，如GRS、GICR、GIGD，将相对应的A、B、C列单元格分别合并，B列单元格填充内容为查询数量，实现效果如F-I列
模糊查询内容保证为连续单元格，不会乱穿插

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。
Sub test()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    arr = [a1].CurrentRegion
    s = Split("GRN GRS GICR GIGD")
    n = 1
    For i = UBound(arr) To 2 Step -1
        For j = 0 To UBound(s)
            If InStr(arr(i, 4), s(j)) Then
                If InStr(arr(i - 1, 4), s(j)) Then
                    n = n + 1
                    Range(Cells(i, 1), Cells(i - 1, 1)).Merge
                    Range(Cells(i, 3), Cells(i - 1, 3)).Merge
                    Range(Cells(i, 2), Cells(i - 1, 2)).Merge
                Else
                    Cells(i, 2) = n
                    n = 1
                End If
                Exit For
            End If
        Next
    Next
    Application.DisplayAlerts = True
    Application.DisplayAlerts = True
    Beep
End Sub

ykcbf1100

参与一下。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.8.15
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     b = Array("GRN", "GRS", "GICR", "GIGD")
   
6.     r = Cells(Rows.Count, 4).End(3).Row
   
7.     arr = [d1].Resize(r, 1)
   
8.     [a:d].UnMerge
   
9.     For x = 0 To UBound(b)
   
10.         k = k + 1
    
11.         n = 0
    
12.         For i = 2 To UBound(arr)
    
13.             If InStr(arr(i, 1), b(x)) Then
    
14.                 n = n + 1
    
15.                 If n = 1 Then d(k) = i
    
16.             End If
    
17.         Next
    
18.     Next
    
19.     For k = 1 To d.Count
    
20.         r1 = d(k)
    
21.         If k = d.Count Then r2 = r Else r2 = d(k + 1) - 1
    
22.         m = r2 - r1 + 1
    
23.         Cells(r1, 2) = m
    
24.         For j = 1 To 3
    
25.             Cells(r1, j).Resize(m).Merge
    
26.         Next
    
27.     Next
    
28.     Set d = Nothing
    
29.     Application.ScreenUpdating = True
    
30.     MsgBox "OK！"
    
31. End Sub
    

复制代码

shiruiqiang

字典嵌套解决也方便

暗夜央

ykcbf1100 发表于 2024-8-15 19:42
参与一下。。。

大佬你好，代码好像有点问题，将我最后一条单个没有模糊查询的不需要合并的AGICR04的那行数据给删除了，是必须要在第五行代码里加上模糊查询内容吗？

暗夜央

ykcbf1100 发表于 2024-8-15 19:42
参与一下。。。

代码把最后一行GICR的和前面的GIGD给合并单元格了

暗夜央

quqiyuan 发表于 2024-8-15 18:21
代码如下。。。
Sub test()
    Application.DisplayAlerts = False

感谢大佬，效果可以的