如何利用公式函数或VBA实现先排序后把指定列相同值合并单元格

huikelhj

求助高手，利用VBA怎么实现对数据排序后合并相同值单元格，详见附件，见下图

yaozong

1. Sub test()
   
2. Dim rng As Range, i&, j&
   
3. Application.DisplayAlerts = False
   
4. Range("a3:k11").Sort key1:=[b2], Header:=xlNo, order1:=1
   
5. Set rg = Cells(3, 2)
   
6. For i = 4 To 12
   
7.   If Cells(i, 2) = Cells(i - 1, 2) Then
   
8.     Set rg = Union(rg, Cells(i, 2))
   
9.   Else
   
10.     For j = 4 To 7
    
11.       rg.Offset(, j).Merge
    
12.     Next
    
13.     rg.Merge
    
14.     Set rg = Cells(i, 2)
    
15.   End If
    
16. Next
    
17. End Sub

复制代码

liangmutou01

Sub hb()
  c = Array(2, 6, 7, 8, 9)
  h = [a65536].End(3).Row
  Range("a1:k" & h).Sort key1:="单号", Header:=xlYes
  For i = 2 To h
    hh = hhao(Cells(i, 2))
    If hh > i Then
      For cc = 0 To UBound(c)
        Range(Cells(i, c(cc)), Cells(hh, c(cc))).Merge
      Next cc
      i = hh
    End If
  Next i
End Sub
Function hhao(dyg As Range) As Long
  Dim dygh As Long, dygl As Integer, h As Long, dygz
  dygz = dyg.Value
  dygh = dyg.Row
  dygl = dyg.Column
  For h = dygh To Rows.Count
    If Cells(h + 1, dygl).Value <> Cells(h, dygl).Value Then Exit For
  Next h
  hhao = Cells(h, dygl).Row
End Function