Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Zeilen mit versch. Suchbegriffen löschen

VBA Zeilen mit versch. Suchbegriffen löschen
22.05.2017 13:32:44
MB12

Hallo zusammen,
eine monatliche Auswertung Tabellenblatt „Dauer“ (Daten stammen von Access-Export) soll bestimmte Datensätze NICHT einbeziehen.
Deshalb müssen alle Zeilen gelöscht werden, die in Spalte C bestimmte (Teil-) Strings aufweisen.
Die auszuschließenden Begriffe sind im Tabellenblatt „NICHT“ in einer Liste, die sich immer wieder ändert
z.B. in Spalte A - "ist gleich":
DE50
DE100
bzw. in Spalte B - "like":
Kühlaggregat
ummy
ntwicklung
Die Listen sind um einiges länger, deshalb meine Frage:
Kann man hieraus Arrays bilden und die entsprechenden Zeilen in Blatt „Dauer“ löschen?
Das Makro könnte zum Beispiel in Spalte H bei jedem Treffer ein „x“ oder „1“ eintragen und am Schluss die entsprechenden Zeilen löschen ?!?
Ich möchte den gesamten Ablauf automatisieren, damit auch die KollegInnen die Auswertung fahren können.
Kleine Basteldatei:
https://www.herber.de/bbs/user/113725.xlsm
Danke schon jetzt für eine Lösung :-)
Gruß, Margarete

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Teste mal...
22.05.2017 14:04:16
Michael
Hallo Margarete,
...direkt in Deiner Bsp-Datei: https://www.herber.de/bbs/user/113726.xlsm
Die Überschrift "Leerspalte" hab ich rausgenommen, sowie die Kennzeichnungseinträge "gleich" und "enthält" im Blatt2, da nicht gebraucht oder hinderlich.
LG
Michael
AW: VBA Zeilen mit versch. Suchbegriffen löschen
22.05.2017 14:07:37
Daniel
HI
1. schreibe auf dem Blatt NICHT die Werte in eine Spalte.
bei den Werten für "enthält" muss am Anfang und Ende ein "*" stehen:
DE50
DE100
*AOM*
*Kühlaggregat*
*mbau*
*ntwicklung*
2. in die Zelle H2 muss dann diese Matrixformel (Eingabe mit STRG+SHIFT+ENTER abschließen, in VBA Formel mit Range("H2").FormulaArray = "..." eintragen)
=WENN(SUMME(ZÄHLENWENN($C2;NICHT!$A$1:$A$6));0;ZEILE())
dann die Formel bis zum Tabellenende kopieren
3. in die Zelle H1 kommt die 1
4. dann auf die ganze Tabelle die Funktion DATEN - DATENTOOLS - DUPLIKATE ENTFERNEN anwenden mit der Spalte H als Kriterium und der Option "keine Überschrift"
5. Spalte H löschen.
sieht als Code so aus:
Sub test()
Dim txt As String
txt = Sheets("Nicht").Cells(1, 1).CurrentRegion.Columns(1).Address(1, 1, xlR1C1)
With Sheets("Dauer").UsedRange
With .Columns(.Columns.Count + 1)
.Cells(2, 1).FormulaArray = "=IF(SUM(COUNTIF(RC3,NICHT!" & txt & ")),0,ROW())"
.Cells(2, 1).Copy
.Resize(.Rows.Count - 2).Offset(2, 0).PasteSpecial xlPasteFormulas
.Cells(1, 1).Value = 0
Debug.Print .Column
.Parent.UsedRange.RemoveDuplicates .Column, xlNo
.ClearContents
End With
End With
End Sub
Gruß Daniel
Anzeige
korrektur: in H1 kommt die 0
22.05.2017 14:10:14
Daniel
Gruß Daniel
AW: VBA Zeilen mit versch. Suchbegriffen löschen
22.05.2017 14:27:16
yummi
Hallo Margarete,
so die Version mit x markieren, kann aber auch mit löschen erweitert werden

Option Explicit
Sub Saeubere()
Dim igleich As Long
Dim ienthaelt As Long
Dim iletzte As Long
Dim wksDauer As Worksheet
Dim wksNicht As Worksheet
Dim lD As Long
Set wksDauer = ThisWorkbook.Sheets("Dauer")
Set wksNicht = ThisWorkbook.Sheets("NICHT")
igleich = BestimmeLetzteZeile(wksNicht, 1)
ienthaelt = BestimmeLetzteZeile(wksNicht, 2)
iletzte = BestimmeLetzteZeile(wksDauer, 1)
For lD = 2 To iletzte
Call EntferneGleich(lD, wksDauer, wksNicht, igleich, 8)
Call EntferneEnthaelt(lD, wksDauer, wksNicht, ienthaelt, 8)
Next lD
End Sub
Function BestimmeLetzteZeile(ByVal wks As Worksheet, ByVal s As Integer) As Long
BestimmeLetzteZeile = wks.Cells(wks.Rows.Count, s).End(xlUp).Row
End Function
Function EntferneGleich(ByVal lD As Long, ByVal wksS As Worksheet, ByVal wksD As Worksheet,  _
ByVal llast As Long, ByVal iSpalte As Integer)
Dim i As Long
For i = 2 To llast
If wksS.Cells(lD, 3).Value = wksD.Cells(i, 1).Value Then
wksS.Cells(lD, iSpalte).Value = "x"
End If
Next i
End Function
Function EntferneEnthaelt(ByVal lD As Long, ByVal wksS As Worksheet, ByVal wksD As Worksheet,  _
ByVal llast As Long, ByVal iSpalte As Integer)
Dim i As Long
For i = 2 To llast
If InStr(1, wksS.Cells(lD, 3).Value, wksD.Cells(i, 2).Value, vbTextCompare)  0 Then
wksS.Cells(lD, iSpalte).Value = "x"
End If
Next i
End Function
Gruß
yummi
Anzeige
DANKE SCHÖN an alle...
22.05.2017 14:58:13
MB12
Hallo liebe Helfer,
danke für alle Lösungen.
@Daniel: Lösung (vor allem auch die Formel-Lösung) kommt in meinen Fundus, aber hier - da ich ein bequemer (um nicht zu sagen fauler) Mensch bin, werde ich die Lösung von Michael einsetzen.
@Yummi: Danke auch dir, den Ansatz mit den Functions muss ich mir mal "reinziehen".
Genießt die Sonne, wenn sie sich mal sehen lässt
Beste Grüße, Margarete
AW: DANKE SCHÖN an alle...
22.05.2017 15:05:14
yummi
Hallo margarete,
einen kleinen Hinweis noch: Ich habe im Tabellenblatt NICHTS enthält und gleich in die 1. Zeile als Überschriften gezogen (nur damit der USER später weiß, welche Liste was bedeutet.
Viel Spass beim Reinziehen ;-)
Gruß
yummi
Anzeige
Gern, Danke für die Rückmeldung! owT
22.05.2017 15:12:41
Michael

360 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige