VBA-Beispiel 050
mail schreiben
mail schreiben

suchen und entfernen / zwei Tabellen
Wenn ein Thema in Tabelle1 mit x markiert wurde soll in Tabelle2, auf dem genau die gleichen Themen stehen, nach dem Namen des Themas, dem Start- und dem Enddatum gesucht und dort gelöscht werden.
Sub suchen_und_in_Tabelle2_entfernen()
Dim Zeile As Long, Spalte As Long  
Dim Thema As String, Start As String, Ende As String    
Dim x As Boolean  
Dim Antwort As Integer    

'Tabelle1 Spalte D nach x durchsuchen
'beginnt mit letztem Eintrag in Spalte D
For Zeile = [D65536].End(xlUp).Row To 2 Step -1  

    If Cells(Zeile, 4) = "x" Then  
        x = True
        Thema = Cells(Zeile, 1)
        Start = Cells(Zeile, 2)
        Ende = Cells(Zeile, 3)
       'Hochkomma weg wenn Zeile in Tabelle1 gelöscht werden soll
       'Rows(Zeile).Delete
        Exit For  
    End If  

Next Zeile

If x = True Then  
Worksheets("Tabelle2").Activate

    For Spalte = 2 To 256     'ab der zweiten alle Spalten durchsuchen
      If Worksheets("Tabelle2").Cells(1, Spalte) = Thema And _  
         Worksheets("Tabelle2").Cells(2, Spalte) = Start And _
         Worksheets("Tabelle2").Cells(3, Spalte) = Ende Then  

            ActiveSheet.Columns(Spalte).Select
           
           'nochmal nachfragen
            Antwort = MsgBox("Spalte löschen?", vbYesNoCancel, "")
           
            If Antwort = 6 Then       'Ja
                ActiveSheet.Columns(Spalte).Delete
                Application.EnableEvents = False
                Worksheets("Tabelle1").Cells(Zeile, 4) = "gelöscht"
                Application.EnableEvents = True
                Spalte = Spalte - 1
            ElseIf Antwort = 7 Then     'Nein
               'nichts tun
            ElseIf Antwort = 2 Then     'Abbrechen
                Exit Sub  
            End If  

      End If  
    Next Spalte

End If  

x = False

End Sub  
Download:   vba050.zip
relevante Links:

top