.Areas.Count是不是与合并单元格无关？

ning84

Range.Areas 属性

返回一个 Areas 集合，该集合表示多重区域选择中的所有区域。只读。语法

表达式.Areas

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

对于单一选择区域，Areas 属性返回只包含一个对象的集合，即原始 Range 对象本身。对于多重选择区域，Areas 属性返回一个集合，该集合包含与每个选定区域相对应的对象。

示例

本示例在用户选定多个区域并试图执行某一命令时显示提示信息。该示例必须在工作表上运行。

Visual Basic for Applications

If Selection.Areas.Count > 1 Then    MsgBox "Cannot do this to a multi-area selection."End If

计算合并单元格的数量。

1. Sub ddd()
   
2.    Dim Rng As Range, oRng As Range
   
3.        Set Rng = Selection
   
4.       
   
5.        With Rng
   
6.            Debug.Print .Address, .Areas.Count
   
7.            For ii = 1 To .Rows.Count
   
8.                If Rng(ii, 1).MergeCells Then
   
9.                     Set oRng = Rng(ii, 1).MergeArea
   
10.                     Debug.Print Rng(ii, 1).Address, oRng.Address, oRng(, 1).Value
    
11.                     ii = ii + oRng.Rows.Count - 1
    
12.                End If
    
13.            Next ii
    
14.        End With
    
15. End Sub
    

复制代码

结果

$A$1:$A$18     1
$A$1          $A$1:$A$3     合并1
$A$4          $A$4:$A$6     合并2
$A$7          $A$7:$A$9     合并3
$A$10         $A$10:$A$12   合并4
$A$13         $A$13:$A$15   合并5
$A$16         $A$16:$A$18   合并6

ynzsvt

那只是选择区域多次而已。与你的代码无关。

longwin

.Areas.Count是不是与合并单元格无关？是

quqiyuan

Areas 集合，该集合表示多重区域选择中的所有区域，跟是否合并单元格没有关系。像union，intersect，range("a1:b20","d2:e5","g3:i20"),这些都有可能产生areas集合

ning84

谢谢解答。

合并单元格数量，只能用MergeCells方法了，没有其它方法。

               If Rng(ii, 1).MergeCells Then
                    Set oRng = Rng(ii, 1).MergeArea
                    Debug.Print Rng(ii, 1).Address, oRng.Address, oRng(, 1).Value
                    ii = ii + oRng.Rows.Count - 1
               End If

ning84

ning84 发表于 2024-8-3 09:56
谢谢解答。

合并单元格数量，只能用MergeCells方法了，没有其它方法。

1. Private Sub CopyWorkbooks()
   
2.      Dim Str
   
3.      Dim Wk As Workbook, Wk1 As Workbook
   
4.          Set Wk = ThisWorkbook
   
5.          Set Wk1 = Workbooks("TraverseDelFolder.xlsm")
   
6.      Dim Win As Window, Win1 As Window
   
7.          Set Win = Application.ActiveWindow
   
8.          Set Win1 = Application.Windows("TraverseDelFolder.xlsm")
   
9.      Dim Sht As Worksheet, Sht1 As Worksheet, oSht As Worksheet
   
10.      Dim WkSht As Worksheet, Wk1Sht As Worksheet
    
11.      Dim Rng As Range, oRng As Range, oRng1 As Range
    
12.      Dim WkRng As Range, Wk1Rng As Range, WkMenuRng As Range
    
13.          Debug.Print Wk.Application.Selection.Address
    
14.          Set oRng = Wk.Application.Selection
    
15.          
    
16.          Set WkMenuRng = Wk.Sheets("Menu").Cells(oRng.Row, 1)
    
17.      
    
18.      Dim Kk, ii, jj
    
19.          Kk = 1
    
20.          Set Wk1Rng = Win1.Selection
    
21.          
    
22.          Set Wk1Sht = Wk1Rng.Parent
    
23.          With Wk1Rng
    
24.              'Debug.Print .Address, .Parent.Name, .Parent.Parent.Name, .Areas.Count,
    
25.              For ii = 1 To .Rows.Count
    
26.                  If Wk1Rng(ii, 1).MergeCells Then
    
27.                     Set oRng = Wk1Rng(ii, 1).MergeArea
    
28.                     oRng(, 2).Resize(oRng.Rows.Count, 3).Copy
    
29.                     ''
    
30.                     WkMenuRng(Kk, 1) = Wk1.Name & "!" & Wk1Rng.Parent.Name & "!" & oRng.Address(0, 0)
    
31.                     Str = Split(oRng(, 1).Value, Chr(10))(0)
    
32.                     
    
33.                     Set oSht = AddSheet(ThisWorkbook, Str)
    
34.                     oSht.Activate
    
35.                     oSht.Cells(10, "A").PasteSpecial xlPasteAll
    
36.                     oRng(, 6).Resize(oRng.Rows.Count, 1).Copy
    
37.                     oSht.Cells(10, "Z").PasteSpecial xlPasteAll
    
38.                     WkMenuRng(Kk, 2) = Str
    
39.                     WkMenuRng(Kk, 3) = "=" & Str & "!" & oSht.Cells(10, 1).CurrentRegion.Address(0, 0)
    
40.                     Kk = Kk + 1
    
41.                     ii = ii + oRng.Rows.Count - 1
    
42.                End If
    
43.              Next ii
    
44.          End With
    
45. 
    
46. End Sub
    

复制代码