VBA合并单元格有几种方法?

ning84

1. Sub Macro1()
   
2.    Application.DisplayAlerts = False
   
3.    Dim Sht As Worksheet
   
4.        Set Sht = Sheet2
   
5.    Dim Rng As Range, oRng As Range
   
6.    Dim Str As String
   
7.    Dim ii: ii = 1
   
8.        Set Rng = Sht.Cells(20, 1).CurrentRegion
   
9.        Debug.Print Rng.Address
   
10.        For jj = 1 To 3
    
11.            Set oRng = Rng(ii, jj)
    
12.            For ii = 1 To Rng.Rows.Count
    
13.                ''
    
14.                If Rng(ii, jj) = Rng(ii + 1, jj) Then
    
15.                    Set oRng = Union(oRng, Rng(ii, jj))
    
16.                ElseIf Rng(ii, jj) <> Rng(ii + 1, jj) Then
    
17.                    'Debug.Print oRng(2, 1).Resize(oRng.Rows.Count).Address
    
18.                    'oRng(2, 1).Resize(oRng.Rows.Count).Merge
    
19.                    Debug.Print oRng.Address
    
20.                    oRng.Merge
    
21.                    Set oRng = Rng(ii, jj)
    
22.                End If
    
23.            Next ii
    
24.            ii = 1
    
25.        Next jj
    
26.        Application.DisplayAlerts = True
    
27. End Sub

复制代码

taller

楼主要解决什么问题？现有代码有什么问题？

ning84

taller 发表于 2024-5-7 09:47
楼主要解决什么问题？现有代码有什么问题？

合并单元格式是不是只有Union(oRng, Rng(ii, jj))一种方法.

字典方法是否可以?

不用Union,如何确定合并单元的Address??

taller

合并单元格最佳方式就是Union，使用单元格地址的方法，如果对于少量单元格是可行的，但是Range(...)参数有255个字符的限制，也就是说单元格地址字符串长度不能超过255

ning84

taller 发表于 2024-5-7 10:39
合并单元格最佳方式就是Union，使用单元格地址的方法，如果对于少量单元格是可行的，但是Range(...)参数有 ...

谢谢回复,琢磨用字典方法,首先计算出重复单元格
set Rng= orng.resiz(重复数,1)
Rng.Union


vba字典重复key_字典(Dictionary)，在VBA语言中的应用-CSDN博客
https://blog.csdn.net/weixin_39556811/article/details/111679149

采用字典方法必须要两次循环, Union方法是最佳方法.

1. 
   
2. Sub ll()
   
3.    Dim Kk As Integer
   
4.    Dim Dict As Dictionary
   
5.        Set Dict = New Dictionary
   
6.    Dim Arr: Arr = Array("bb", "aa", "aa", "bb", "cc", "aa", "bb", "cc", "aa", "bb", "cc", "aa")
   
7.        For ii = 0 To UBound(Arr)
   
8.             Dict(Arr(ii)) = ""
   
9.        Next ii
   
10.       
    
11.        For ii1 = 0 To Dict.Count - 1
    
12.          For ii = 0 To UBound(Arr)
    
13.            If Dict.Keys(ii1) = Arr(ii) Then
    
14.                Kk = Kk + 1
    
15.                'Debug.Print Kk
    
16.            End If
    
17.          Next ii
    
18.          Debug.Print Dict.Keys(ii1), "///", Kk
    
19.          Kk = 0
    
20.          Stop
    
21.        Next ii1
    
22. End Sub

复制代码