Question

我总共使用了两个UDF's，并想与他们一起创建一个marco

Union of Ranges
获得范围的complement或difference以及工作表的使用范围

我知道还有其他方法可以做我正在尝试但想看看我是否可以使用这种方法

当我尝试复制我制作的That command cannot be used on multiple selections范围时，我收到错误complement

我看不到multiple选择的位置！

由于

Sub Test()
Dim r1 As Range, r2 As Range, r3 As Range

Set r1 = Sheets("Nodes").Range("A1:D1, G1:G1, I1:K1")
Set r2 = UnionRange("Nodes", False, r1)
Set r3 = DiffRngAndUsedRange(r2, "Nodes")

'want to use like this
 DiffRngAndUsedRange(r2, "Nodes").Copy _
                                 Destination:=Sheets("X").Range("A1")

'I get the proper range if I select it with r3.Select
'I can delete the range r3 with r3.Delete
'I get error if I try to copy with r3.copy

End Sub

获得范围联盟：编辑，根据评论更新代码

Function UnionRange(shtName As String, useInputbox As Boolean, Optional rng As Range) As Range
Dim ws As Worksheet
Dim usedRng As Range

   Set ws = ThisWorkbook.Sheets(shtName)

   If useInputbox = True Then
     On Error Resume Next
     Set rng = Application.InputBox("Select column(s)", Type:=8)
     On Error GoTo 0

   ElseIf useInputbox = False Then
     If rng Is Nothing Then Exit Function

   End If

   With ws
      Set UnionRange = Intersect(.UsedRange, rng.EntireColumn)
   End With

End Function

获取Range和UsedRange的补充：

Function DiffRngAndUsedRange(rngA As Range, UsedRangeShtName As String) As Range
Dim ws As Worksheet
Dim rngB As Range, rngC As Range, rCell As Range

Set ws = ThisWorkbook.Sheets(UsedRangeShtName)
Set rngB = ws.UsedRange

For Each rCell In Union(rngA, rngB)
    If Intersect(rCell, rngA, rngB) Is Nothing Then
        If rngC Is Nothing Then
            Set rngC = rCell
        Else
            Set rngC = Union(rngC, rCell)
        End If
    End If
Next
Set DiffRngAndUsedRange = rngC

End Function

在复制粘贴

0 个答案: