Werte/Inhalte in Spalte durch Abgleich mit anderer Spalte automatisch löschen

[PeterN]

Hola los Todos!

Ich habe in einer Spalte ein paar hundert Zeilen nach dem Schema:

Liste vorher:

Code:

<p>Inhalt1</p><p>Inhalt2</p><p>Inhalt3</p><p>Inhalt4</p><p>Inhalt100</p>usw. 

<p>Inhalt11</p><p>Inhalt12</p><p>Inhalt14</p><p>Inhalt100</p>usw. 

<p>Inhalt21</p><p>Inhalt22</p><p>Inhalt3</p><p>Inhalt24</p>usw.

 

Manche Zeilen haben nur einen Inhaltsblock manche mehr wie hundert.

Dann habe ich eine Spalte mit Inhaltsblöcken, die ein bis mehrfach in den Zeilen vorkommen, aber in jeder Zeile maximal einmal.

Code:

<p>Inhalt100</p>
<p>Inhalt200</p>
<p>Inhalt3</p>
<p>Inhalt400</p>usw.

Ich würde gerne diese Spalte gegen die Zeilen laufen lassen und alle Inhaltsblöcke, die in den Zeilen vorkommen, automatisch löschen lassen.

Code:

Ergebnis in dem Fall <p>Inhalt3</p> und <p>Inhalt100</p> sind gelöscht.

Liste nachher:

Code:

<p>Inhalt1</p><p>Inhalt2</p><p>Inhalt4</p>usw.
<p>Inhalt11</p><p>Inhalt12</p><p>Inhalt14</p>usw. 
<p>Inhalt21</p><p>Inhalt22</p><p>Inhalt24</p>usw.

Danke und Gruss

Peter

[Elex]

Hi

scheint ein Endlos-Projekt zu sein. ;-)

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Werte As Variant, j As Long

With Sheets("Tabelle1")    'Blattnamen anpassen
 Werte = .Range("D1").CurrentRegion     'in D1:D? stehen die einzelnen Inhaltsblöcke
   For j = 1 To UBound(Werte, 1)
     .Columns(1).Replace Werte(j, 1), ""   'in Spalte A stehen die Texte
   Next j
End With
End Sub

Gruß Elex

[UweD]

Hallo

mit folgendem Makro.

Code:

Sub Tauschen()
   Dim TB1, TB2, LR As Long, i As Long, SP1 As Integer, SP2 As Integer, TTausch As String
   Set TB1 = Sheets("Tabelle1")
   Set TB2 = Sheets("Tabelle2")
   
   SP1 = 1 ' Text steht in Spalte A
   SP2 = 1 ' Löschtext steht in Spalte A

   LR = TB2.Cells(TB2.Rows.Count, SP2).End(xlUp).Row 'letzte Zeile der Spalte
   
   For i = 1 To LR
       TTausch = TB2.Cells(i, SP2)
       
       With TB1.Columns(SP1)
           .Replace What:=TTausch, Replacement:="", LookAt:= _
               xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
               ReplaceFormat:=False
       End With
   Next
End Sub

LG UweD

[PeterN]

Hi Elex!

Vielen Dank.

Ich bekomme das Makro (mit Doppelklick) zum Starten, aber dann kommt die Meldung: Laufzeitfehler: `13` Typen unverträglich.

Dabei bin ich eigentlich ein ganz verträglicher Typ.

Eventuell hab ich das Makro mal wieder falsch gespeichert.

Anbei mein Versuch.

Eventuell kannst Du mir eine funktionierende Liste zurückschicken.

Oder bezog sich Deine Lösung auf unser letztes gemeinsames Projekt: https://www.clever-excel-forum.de/Thread...en-mischen?

Gruss

Peter

---

Hi Uwe!

Vielen Dank.

Ich bekomme das Makro leider nicht zum Starten.

Eventuell hab ich das Makro mal wieder falsch gespeichert.

Anbei mein Versuch.

Eventuell kannst Du mir eine funktionierende Liste zurückschicken.

Gruss

Peter

[Elex]

Hi,

du musst nur die Daten von Spalte B nach D verschieben.
Spalte C Und E müssen leer sein. 

Gruß Elex

[UweD]

Hallo


mein Makro muss diesmal in ein Normales Modul.

Das reicht dann auch.

Code:

Sub Tauschen()
  Dim LR As Long, i As Long, SP1 As Integer, SP2 As Integer, TTausch As String
  SP1 = 1 ' Text steht in Spalte A
  SP2 = 2 ' Löschtext steht in Spalte B

  LR = Cells(Rows.Count, SP2).End(xlUp).Row 'letzte Zeile der Spalte
 
  For i = 1 To LR
      TTausch = Cells(i, SP2)
     
      Columns(SP1).Replace What:=TTausch, Replacement:="", LookAt:= _
              xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
              ReplaceFormat:=False
  Next
End Sub

LG UweD

[PeterN]

Super! Klasse! Danke Ihr Beiden!

Jetzt geht es.

Wie würden die Lösungen denn aussehen, wenn ich statt Zeilen in EINER Spalte in einem Arbeitsgang gleich in VIER Spalten löschen möchte?

Also die Zeilen (alle nach demselben Muster) stehen in Spalte A bis D und die zu löschenden in Spalte E.

Gruss

Peter

[Elex]

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Werte As Variant, j As Long

With Sheets("Tabelle1")
 Werte = .Range("E1:E" & .Cells(.Rows.Count, 5).End(xlUp).Row)
   For j = 1 To UBound(Werte, 1)
     .Columns("A:D").Replace Werte(j, 1), ""
   Next j
End With
End Sub

In Spalte E müssen mind. 2 Zeilen Werte haben. Solltest du nur einen Inhalt Ausfilter wollen, schreibe in E2 einfach
einen Text der nicht vorkommen kann.   z.B. "##"


Gruß Elex

[PeterN]

Vierfach SuperKlasseDanke!

Nur zum besseren Verständnis. Diese Lösung löscht in ein bis vier Spalten bzw. max. vier Spalten. Wenn ich die Lösung auf 5 Spalten anpassen wollte , würde das so aussehen?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Werte As Variant, j As Long

With Sheets("Tabelle1")
 Werte = .Range("F1:F" & .Cells(.Rows.Count, 6).End(xlUp).Row)
   For j = 1 To UBound(Werte, 1)
     .Columns("A:E").Replace Werte(j, 1), ""
   Next j
End With
End Sub

Oder bei mehr Spalten die von mir fett markierten Bereiche dementsprechend anpassen.

Genial ist das die Lösung auch Zeilen in den Spalten oder ganze Spalten überspringt, die leer sind und trotzdem alle definierten Spalten abfragt.

Noch einmal ganz herzlichen Dank

Peter

[Elex]

Wenn ich die Lösung auf 5 Spalten anpassen wollte.

Anpassung geglückt.  :100: