VBA für mehrere Kriterien zu suchen, und löschen Sie die Spalten, die diese Kriterien nicht enthalten

Question

Ich habe das unten zusammengestellt, aber ich bin nicht vertraut mit VBA, so dass es offensichtlich nicht funktioniert.

Sub DeleteUneededColumn() 
Dim FindString As String 
Dim Rng As Range 
FindString = "Type" 
If Trim(FindString) <> "" Then 
    With Sheets("page 1").Range("A:ZZ") 
     Set Rng = .Find(What:=FindString, _ 
         After:=.Cells(.Cells.Count), _ 
         LookIn:=xlValues, _ 
         LookAt:=xlWhole, _ 
         SearchOrder:=xlByRows, _ 
         SearchDirection:=xlNext, _ 
         MatchCase:=False) 
     If Rng Is Nothing Then 
      Rng.EntireColumn.Delete 
     End If 
    End With 
End If 
End Sub 

Gemäß dem Titel, braucht es mehrere Kriterien zu finden (Im Idealfall einige Keywords basierend auf I in Zellen A1:A3 auf Sheet1 eingegeben haben), habe ich versucht, es mit nur einem ersten, aber keine Freude zum Laufen zu bringen. Löschen Sie dann für jede Spalte in page 1, die diese Wörter nicht enthält, diese Spalte.

Ich verstehe .Find wird ein großer Teil davon sein, aber nicht sicher auf den Rest.

Answer 1

Suchen gibt den Bereich mit dem ersten Vorkommen zurück, in dem die Zeichenfolge gefunden wurde und Sie den gesamten Bereich durchsuchen.

Ich habe Ihren Code so geändert, dass er spaltenweise erscheint und alle Spalten sammelt, in denen die Zeichenfolge nicht gefunden wird, und löscht diesen Bereich.

Sub DeleteUneededColumn() 

Dim FindString As String 
Dim Rng As Range 

FindString = "C" 

Dim rngCol As Range, rngDelete As Range 

For Each rngCol In Range("A:ZZ").Columns 
    Set Rng = rngCol.Find(What:=FindString, _ 
         LookIn:=xlValues, _ 
         LookAt:=xlWhole, _ 
         SearchOrder:=xlByRows, _ 
         SearchDirection:=xlNext, _ 
         MatchCase:=False) 
    If Rng Is Nothing Then 
     If rngDelete Is Nothing Then 
      Set rngDelete = rngCol 
     Else 
      Set rngDelete = Union(rngDelete, rngCol) 
     End If 
    End If 

Next 

rngDelete.Delete 

End Sub