求大神完善查询关键字合并指定单元格

人气人

我期望效果也加上了代码  本来是合并的单元格就不显示查询结果了

边缘码农

代码已发，审核中。

边缘码农

1. Sub 查询并合并单元格()
   
2.     Dim i As Long, j As Long, SL As Long
   
3.     Dim HuoZhu As String
   
4.     Dim Kshc As Long, Jghs As Long
   
5.     SL = 1
   
6.     Kshc = 9
   
7.     Jghs = 6
   
8.     With Sheets("明细表")
   
9.         i = .Range("a65536").End(xlUp).Row
   
10.         barr = .Range("A1:G" & i)
    
11.         HuoZhu = .Cells(3, 2)
    
12.     End With
    
13.     ReDim carr(1 To i * Jghs, 1 To UBound(barr, 2))
    
14.     For i = 1 To UBound(barr)
    
15.         If barr(i, 2) = HuoZhu Then
    
16.             For j = 1 To UBound(barr, 2)
    
17.                 carr(SL, j) = barr(i, j)
    
18.             Next j
    
19.             SL = SL + Jghs
    
20.         End If
    
21.     Next i
    
22.     Sheets("期望效果").Cells(Kshc, 1).Resize(SL, UBound(barr, 2)) = carr
    
23.     For i = 1 To SL - 1 Step Jghs
    
24.         For j = 1 To UBound(barr, 2)
    
25.             Range(Cells(i + Kshc - 1, j), Cells(i + Kshc + Jghs - 2, j)).Select
    
26.                 If Selection.MergeCells = False Then
    
27.                     Selection.Merge
    
28.                 End If
    
29.         Next j
    
30.     Next i
    
31.     MsgBox "查询、合并单元格完成!"
    
32. End Sub
    

复制代码