复制之前，如何判断多重选择区域是否可以复制？（VBA）

tobeahumanbeing

EXCEL表格，
多重选择区域，选择后，没有复制的动作，如何判断多重选择区域是否可以复制？

ww87725244

是否可以复制，不是代码决定，是你决定

tobeahumanbeing

ww87725244 发表于 2024-9-10 11:50
是否可以复制，不是代码决定，是你决定

如果可以复制的，复制的时候就不会弹出对话框

不能复制的，复制的时候就会弹出

ynzsvt

这个判断比较困难的，多个区域都是需要对齐的才能拷贝哟。

大灰狼1976

因为是多重选区，所以不太适合用selectionchange事件，如果是单独的过程来判断，如下：

1. Sub test()
   
2. On Error Resume Next
   
3. Application.DisplayAlerts = False
   
4. Selection.Copy
   
5. Application.CutCopyMode = False
   
6. Application.DisplayAlerts = True
   
7. If Err Then MsgBox "error" Else MsgBox "ok"
   
8. End Sub

复制代码

ynzsvt

1. Sub 多重区域可拷贝否()
   
2. Dim Rng As Range, DicC As Object, DicR As Object
   
3. Dim Rng1 As Range, St$, pD As Boolean
   
4. Set DicC = CreateObject("Scripting.Dictionary")
   
5. Set DicR = CreateObject("Scripting.Dictionary")
   
6. 
   
7. pD = True
   
8. Set Rng = Selection
   
9. For Each Rng1 In Rng.Areas
   
10. Debug.Print Rng1.Address
    
11. If Not DicR.exists(Rng1.Row) Then
    
12. Set DicR(Rng1.Row) = CreateObject("Scripting.Dictionary")
    
13. End If
    
14. DicR(Rng1.Row)(Rng1.Rows.Count) = ""
    
15. If DicR(Rng1.Row).Count > 1 Then pD = False
    
16. 
    
17. If Not DicC.exists(Rng1.Column) Then
    
18. Set DicC(Rng1.Column) = CreateObject("Scripting.Dictionary")
    
19. End If
    
20. DicC(Rng1.Column)(Rng1.Columns.Count) = ""
    
21. If DicC(Rng1.Column).Count > 1 Then pD = False
    
22. Next
    
23. 
    
24. If DicR.Count * DicC.Count <> Rng.Areas.Count Then pD = False
    
25. If pD Then MsgBox "可拷贝" Else MsgBox "不可拷贝"
    
26. 
    
27. Set DicC = Nothing
    
28. Set DicR = Nothing
    
29. End Sub

复制代码

tobeahumanbeing

大灰狼1976 发表于 2024-9-10 12:41
因为是多重选区，所以不太适合用selectionchange事件，如果是单独的过程来判断，如下：

没有复制的动作，如何判断多重选择区域是否可以复制？
没有复制的动作
没有复制的动作
没有复制的动作

lss001

'判断一下行数是否相等

Set Rng = Selection '当前选择
c = Rng.Areas.Count '区域个数
k = 0 '初始化k
p = Rng.Areas(1).Rows.Count
For Each rn In Rng.Areas
    If rn.Rows.Count = p Then k = k + 1
Next
If k = c Then
     'Rng.Copy '复制
Else
    'MsgBox "无法复制"
End If

大灰狼1976

没有要求你有复制的动作啊，代码里尝试复制一下，而且马上取消复制模式，不影响正常操作。

ynzsvt

我的代码要再加一个字典判断是否重复选取一块。