Excel UDF删除或移动不在数组中的所有列
我正在尝试编写一个UDF,它将移动或删除数组中的所有列 这部分我有 我还想删除或移动不在数组中的所有列,而这部分我被卡住了 这是函数的情况2和4 在此方面的任何帮助都将不胜感激 谢谢 编辑:更新了David G提供的答案 原始问题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
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