Question

我正在尝试编写一个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

Answer 1

我发现这个函数反转了选择，可能就是你需要的：

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

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

1 个答案: