用union方法做单元格区域合并方面的问题

xzh_yzcn

各位老师：
      用 union方法做单元格区域合并遇到问题请指点。我的代码如下：
      Sub 单元格区域合并()

'指定需合并的列
Set hbxrng = Application.InputBox("请选择“需合并的列”标题单元格(1个或多个单元格）", "", , , , , , 8)     '返回单元格
hbxcount = hbxrng.Cells.Count
If hbxcount = 1 Then
    hbxcol1 = hbxrng.Column
    Set urng1 = Range(Cells(2, hbxcol1), Cells(21, hbxcol1))
ElseIf hbxcount > 1 Then
    Dim hbxcol()
    ReDim Preserve hbxcol(1 To hbxcount)
    hbxstr = Split(hbxrng.Address, ",")
    For i = 1 To hbxcount
        lwz = InStr(hbxstr(i - 1), "$")
        rwz = InStrRev(hbxstr(i - 1), "$")
        hbxcol(i) = Range(Mid(hbxstr(i - 1), 1 + lwz, rwz - (lwz + 1)) & 1).Column
        'hbxcol(i) = hbxrng(i).Column
        If i = 1 Then
            Set urng1 = Range(Cells(2, hbxcol(i)), Cells(21, hbxcol(i)))
            Debug.Print urng1.Rows.Count
            Debug.Print urng1.Columns.Count
        Else:
            Set urng1 = Union(urng1, Range(Cells(2, hbxcol(i)), Cells(21, hbxcol(i))))
            '当选择2列合并为单元格区域，此处的列数应为2，但结果却为1，错在哪里
            Debug.Print urng1.Rows.Count
            Debug.Print urng1.Columns.Count
        End If
    Next
End If
End Sub

请老师指点 ，谢谢
指定单元格区域合并.zip (15.25 KB, 下载次数: 17)

2016-4-9 08:11 上传

点击文件名下载附件

wj2368

不知道你要干吗，错误在这 Set urng2 = Union(urng1, Range(Cells(2, okmtjxcol(i)), Cells(21, okmtjxcol(i))))，这个对象没有啊，改为urng2

Vicel

Sub 指定单元格区域合并()
'假设选择项目3与项目6
Set okmtjxrng = Application.InputBox("请选择汇总条件项的单元格(1个或多个单元格）", "", , , , , , 8)     '返回单元格
'选定的单元格有两个
okmtjxcount = okmtjxrng.Cells.Count
If okmtjxcount = 1 Then
    okmtjxcol1 = okmtjxrng.Column
    okmtjx = okmtjxrng
    Set urng2 = Range(Cells(2, okmtjxcol1), Cells(21, okmtjxcol1))
ElseIf okmtjxcount > 1 Then
    Dim okmtjxcol()
    ReDim Preserve okmtjxcol(1 To okmtjxcount)
    For i = 1 To okmtjxcount
        okmtjxcol(i) = okmtjxrng(i).Column
        '当i=1时，okmtjxrng(i).Column=3，当i=2时，okmtjxrng(i).Column=6
        '而此处当i=2时，okmtjxrng(i).Column=3，这是为什么，请指点
        '假设选择项目3与项目6，okmtjxrng(1)表示的是C1单元格，okmtjxrng(2)表示的是C2单元格
        If i = 1 Then
            Set urng2 = Range(Cells(2, okmtjxcol(i)), Cells(21, okmtjxcol(i)))
        Else:
            Set urng2 = Union(urng2, Range(Cells(2, okmtjxcol(i)), Cells(21, okmtjxcol(i))))
        End If
    Next
End If
End Sub

Sub 指定单元格区域合并1()
    '假设选择项目3与项目6
    Dim rng As Range, rng2 As Range, cell As Range, ar
    Set rng = Application.InputBox("请选择汇总条件项的单元格(1个或多个单元格）", "", , , , , , 8)    '返回单元格
    '选定的单元格有两个
    ar = ActiveSheet.UsedRange
    For Each cell In rng
        If rng2 Is Nothing Then
            Set rng2 = cell.Offset(1).Resize(UBound(ar) - 1)
        Else
            Set rng2 = Union(rng2, cell.Offset(1).Resize(UBound(ar) - 1))
        End If
    Next
End Sub

对于模块2的问题

Columns 属性Office 2013 and later

返回一个 Range 对象，它代表指定区域中的列。

语法

表达式.Columns

表达式 一个代表 Range 对象的变量。

注解

在不使用对象识别符的情况下使用此属性等效于使用 ActiveSheet.Columns。

此属性在应用于一个是多重选定区域的 Range 对象时，会只从该区域的第一个子区域中返回列。例如，如果 Range 对象有两个子区域 A1:B2 和 C3:D4，那么，Selection.Columns.Count 的返回值是 2，而不是 4。若要对一个可能包含多重选定区域的区域使用此属性，请测试 Areas.Count 以确定此区域内是否包含多个子区域。如果包含，请对此区域内的每个子区域进行循环

xzh_yzcn

Vicel 发表于 2016-4-9 11:33
Sub 指定单元格区域合并()
'假设选择项目3与项目6
Set okmtjxrng = Application.InputBox("请选择汇总条 ...

谢谢指点，此属性在应用于一个是多重选定区域的 Range 对象时，会只从该区域的第一个子区域中返回列。

ning84

用rng(,jj*col+1)方法，容易出错。
Set MergeRng = Union(MergeRng, oRng)方法虽然麻烦，不容易出错。

1. 
   
2. Sub del10210()
   
3.    Dim mRng As Range, Rng As Range, Rng1 As Range, Rng2 As Range
   
4.    Dim AddArr, WeaArr
   
5.        AddArr = Array("A2", "A11", "A20", "A29", "A38", "A47", "A56")
   
6.        WeaArr = Array("C1", "C2", "C3", "C4", "C5", "C6", "C7", "C8")
   
7.        Set Rng = Range(Cells(1, 1).Formula)
   
8.        Set mRng = Rng(1, 1).MergeArea
   
9.       
   
10.        For jj = 0 To UBound(AddArr)
    
11.             Set Rng1 = Rng(, jj * (mRng.Columns.Count + 1) + 1)
    
12.             For jj1 = 0 To UBound(WeaArr)
    
13.                    Rng1(3, jj1 + 1) = AddArr(jj) & WeaArr(jj1)
    
14.             Next jj1
    
15.             Debug.Print Rng1.Address
    
16.        Next jj
    
17. End Sub
    
18. ''
    
19. Sub del20210()
    
20.    Dim MergeRng As Range, mRng As Range
    
21.    Dim Rng As Range, Rng1 As Range, Rng2 As Range
    
22.    Dim oRng As Range, oRng1 As Range, oRng2 As Range
    
23.    Dim AddArr, WeaArr
    
24.        AddArr = Array("A2", "A11", "A20", "A29", "A38", "A47", "A56")
    
25.        WeaArr = Array("C1", "C2", "C3", "C4", "C5", "C6", "C7", "C8")
    
26.        Set Rng = Range(Cells(1, 1).Formula)
    
27.        Set MergeRng = Rng.Find(AddArr(0), LookAt:=xlWhole).MergeArea
    
28.        For jj = 1 To UBound(AddArr)
    
29.             Set oRng = Rng.Find(AddArr(jj)).MergeArea
    
30.             Set MergeRng = Union(MergeRng, oRng)
    
31.             'Debug.Print MergeRng.Address
    
32.        Next jj
    
33.        Set mRng = Rng(1, 1).MergeArea
    
34.        ii = 10
    
35.        For jj = 1 To MergeRng.Areas.Count
    
36.             Set oRng = Cells(ii, MergeRng.Areas(jj).Column)
    
37.             ''
    
38.             For jj1 = 0 To UBound(WeaArr)
    
39.                    oRng(, jj1 + 1) = AddArr(jj - 1) & WeaArr(jj1)
    
40.             Next jj1
    
41.             
    
42.        Next jj
    
43. End Sub
    
44. 
    

复制代码