从数组中删除不包含值的整列

Question

我需要删除工作表中的整列，这取决于该列中的单元格是否包含单元格中的值。我在另一个网站上发现了这段代码，由于某种原因我无法链接到它。这段代码对我来说完美无瑕，只是如果单元格包含数组中的值，它会删除所有列。我希望它做相反的事情：如果列不包含数组中的值，就删除它。基本上与它的作用相反。

这是代码：

Sub ModifyTICBData()
Dim varList As Variant
Dim lngarrCounter As Long
Dim rngFound As Range, rngToDelete As Range
Dim strFirstAddress As String
'Application.ScreenUpdating = False
varList = VBA.Array("Departure Time", "Trailer Type", "From Depot / Store Name ", "Trip Position", "To Store Number", "To Store / Depot Name", "Product Code", "Pallets") 'I want to keep columns with these values, NOT DELETE THEM
For lngarrCounter = LBound(varList) To UBound(varList)
With Sheets("Nastavit D").UsedRange
Set rngFound = .Find( _
What:=varList(lngarrCounter), _
Lookat:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=True)
If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
If rngToDelete Is Nothing Then
Set rngToDelete = rngFound
Else
If Application.Intersect(rngToDelete, rngFound.EntireColumn) Is Nothing Then
Set rngToDelete = Application.Union(rngToDelete, rngFound)
End If
End If
Set rngFound = .FindNext(After:=rngFound)
Do Until rngFound.Address = strFirstAddress
If Application.Intersect(rngToDelete, rngFound.EntireColumn) Is Nothing Then
Set rngToDelete = Application.Union(rngToDelete, rngFound)
End If
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
Next lngarrCounter
If Not rngToDelete Is Nothing Then rngToDelete.EntireColumn.Delete
'Application.ScreenUpdating = True

End Sub

Answer 1

请按原样使用您的代码，但替换：

If Not rngToDelete Is Nothing Then rngToDelete.EntireColumn.Delete

带有：

Dim rngDel As Range
Set rngDel = NotIntersectRng(Sheets("Nastavit D").UsedRange, rngToDelete)
If Not rngDel Is Nothing Then rngDel.EntireColumn.Delete

并复制同一模块中的下一个功能：

Private Function NotIntersectRng(rng As Range, rngF As Range) As Range
Dim rngNI As Range, i As Long, j As Long
For i = 1 To rng.Columns.count
If Intersect(rng.cells(1, i).EntireColumn, rngF) Is Nothing Then    
If rngNI Is Nothing Then
Set rngNI = rng.cells(1, i)
Else
Set rngNI = Union(rngNI, rng.cells(1, i))
End If
End If
Next i
If Not rngNI Is Nothing Then Set NotIntersectRng = rngNI
End Function

该函数检查与包含数组字符串的列不相交的列，并创建一个范围。这个将用于删除整列。。。