UDF 删除或移动不在数组中的所有列

UDF to delete or move all columns not in array

我正在尝试编写一个 UDF,它将Move or Delete 数组中的所有列

这部分我有

我还想 Delete or Move 数组中的所有列 not,这部分我被卡住了。

这是函数的情况 2 和情况 4

感谢任何帮助 谢谢

编辑:更新了 David G

提供的答案
Function InvertRng(shtName As String, r As Range) As Range
Dim rng As Range
Dim Rng1 As Range, Rng2 As Range

Set Rng1 = GetUsedRange(shtName, 1, True)
For Each rng In Rng1
    If Application.Intersect(rng, r) Is Nothing Then
        If InvertRng Is Nothing Then
            Set InvertRng = rng
        Else
            Set InvertRng = Application.Union(InvertRng, rng)
        End If
    End If
Next

End Function

原问题

Sub MoveOrDelete_n()

    MoveOrDelete 2, "Elements", "NewSheet", Array("Id", "Type", "Description")

End Sub

函数

Function MoveOrDelete(iwhat As Long, SshtName As String, TshtName As String, arrHeaders As Variant) 'Excel VBA to move Columns based on criteria
Dim wsS As Worksheet, wsT As Worksheet
Dim ar As Variant
Dim fn As Range, r As Range
Dim str As String
Dim i As Long

Set wsS = ThisWorkbook.Sheets(SshtName)
Set wsT = ThisWorkbook.Sheets(TshtName)

For i = 0 To UBound(arrHeaders) 'Loop through the Array
    Set fn = wsS.Rows("1:1").Find(arrHeaders(i), LookAt:=xlWhole)
    str = str & fn.Address & ","
Next i

'Remove the trailing comma from the string
 str = Left(str, Len(str) - 1)
 Set r = wsS.Range(str).EntireColumn

Select Case iwhat

    Case 1
     'Delete all columns IN list
      r.Delete

   Case 2
     'Delete all columns NOT in list
      invertR.Delete

   Case 3
     'Move all columns IN List to NEW Sheet
      r.Copy wsT.[a1]

   Case 4
     'Move all columns NOT in List to NEW SheeT
      invertR.Copy wsT.[a1]


End Select   
End Function

我发现了这个反转选择的功能,也许是你需要的:

Sub InvertSelection()
'Updateby20140314
Dim rng As Range
Dim Rng1 As Range
Dim Rng2 As Range
Dim OutRng As Range
xTitleId = "KutoolsforExcel"
Set Rng1 = Application.Selection
Set Rng1 = Application.InputBox("Range1 :", xTitleId, Rng1.Address, Type:=8)
Set Rng2 = Application.InputBox("Range2", xTitleId, Type:=8)
For Each rng In Rng2
    If Application.Intersect(rng, Rng1) Is Nothing Then
        If OutRng Is Nothing Then
            Set OutRng = rng
        Else
            Set OutRng = Application.Union(OutRng, rng)
        End If
    End If
Next
OutRng.Select
End Sub

https://www.extendoffice.com/documents/excel/762-excel-reverse-selections.html