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

Excel UDF删除或移动不在数组中的所有列,excel,user-defined-functions,vba,Excel,User Defined Functions,Vba,我正在尝试编写一个UDF,它将移动或删除数组中的所有列 这部分我有 我还想删除或移动不在数组中的所有列,而这部分我被卡住了 这是函数的情况2和4 在此方面的任何帮助都将不胜感激 谢谢 编辑:更新了David G提供的答案 原始问题 Sub MoveOrDelete_n() MoveOrDelete 2, "Elements", "NewSheet", Array("Id", "Type", "Description") End Sub 功能 Function MoveOrDelet

我正在尝试编写一个UDF,它将移动或删除数组中的所有列

这部分我有

我还想删除或移动不在数组中的所有列,而这部分我被卡住了

这是函数的情况2和4

在此方面的任何帮助都将不胜感激 谢谢

编辑:更新了David G提供的答案

原始问题

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

为什么是函数?函数返回一些东西,而sub做一些事情。
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