Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 00:42:03
Listbox mit gefilterten Daten füllen
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1160to1164
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1160to1164
1160to1164
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro abändern

Makro abändern
Karin
Hallo ihr Experten,
folgendes Makro löscht alle doppelten Einträge in Spalte A 
Sub DoppelteLöschen()
Dim x As Long
For x = Range("A65536").End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("A1:A" & x), Cells(x, 1)) > 1 Then
Cells(x, 1).EntireRow.Delete
End If
Next
End Sub

Wer kann mir das Makro so abändern, dass nur die Spalten bestehen bleiben,
die in Spalte A als Schlüssel "PROD" stehen haben.
Alle anderen Zeilen sollen gelöscht werden.
Vielen Dank im voraus.
Gruß
Karin
Userbild

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro abändern
14.06.2010 15:11:00
Tipp
Hallo Karin
so:
Sub Zeile_weg_wenn()
Const suchbegriff = "prod"
Dim Z As Long, lZ As Long, i As Long
Z = ActiveSheet.UsedRange.Row
lZ = Z + ActiveSheet.UsedRange.Rows.Count - 1
For i = lZ To Z Step -1
If Application.CountIf(Rows(i), suchbegriff) > 0 Then
Else
Rows(i).Delete
End If
Next
End Sub
Grüße vom Tipp
AW: Makro abändern
14.06.2010 15:30:12
Karin
Hallo Tipp,
vielen Dank für deine schnelle Antwort.
Funktioniert super dein Makro.
Ich habe leider noch was vergessen.
Das Makro haut natürlich auch die Überschriften weg.
Könntest du das so erweitern das erst ab Zeile 4 die Daten verglichen werden?
Liebe Grüße
Karin
Anzeige
Z = WorksheetFunction.Max(4, ...)
14.06.2010 16:06:20
Luc:-?
Hi Karin,
für die … trägst du das ein, was Z bisher zugewiesen wird.
Gruß Luc :-?
AW: Makro abändern
14.06.2010 16:10:29
Tipp
Hallo Karin
dann so:
Sub Zeile_weg_wenn()
Const suchbegriff = "prod"
Dim lZ As Long, i As Long
lZ = ActiveSheet.UsedRange.Rows.Count
For i = lZ To 5 Step -1
If Application.CountIf(Rows(i), suchbegriff) > 0 Then
Else
Rows(i).Delete
End If
Next
End Sub
Grüße vom Tipp
Warum gleich so brutal, dein Ansatz war...
14.06.2010 16:16:55
Luc:-?
…vorher allgemeiner, Tipp… ;-)
Wenn man die 4 (warum 5 ?) auch noch als Const anlegen würde, wäre das Pgm recht pflegeleicht!
Gruß Luc :-?
AW: Warum gleich so brutal, dein Ansatz war...
14.06.2010 16:24:13
Tipp
Hallo Luc
hast ja recht! Fehler meinerseits, dachte 4 Zeilen Überschrift, ab der 5. solls losgehen.
Ich denke, Karin kanns nun richtig einbauen.
Grüße vom Tipp
Anzeige
AW: Makro abändern
14.06.2010 16:34:59
Karin
Hallo Tipp,
ich habe es ausprobiert, leider lässt das Makro einen falschen Satz stehen.
Hast du noch eine Idee?
Ich kann mich erst morgen wieder melden.
Liebe Grüße
Karin
Userbild
AW: Makro abändern
14.06.2010 16:37:59
Tipp
Hallo Karin
dann so und Luc ist auch zufrieden!
Sub Zeile_weg_wenn1()
Const suchbegriff = "prod"
Dim Z As Long, lZ As Long, i As Long
Z = WorksheetFunction.Max(4, ActiveSheet.UsedRange.Row)
lZ = Z + ActiveSheet.UsedRange.Rows.Count - 1
For i = lZ To Z Step -1
If Application.CountIf(Rows(i), suchbegriff) > 0 Then
Else
Rows(i).Delete
End If
Next
End Sub
Grüße vom Tipp
Anzeige
Variante
14.06.2010 17:46:54
Erich
Hi zusammen,
wäre diese Variante ok? 

Option Explicit
Sub Zeile_weg_wenn2()
Dim rngC As Range, rngDel As Range
Const strSuchbegr As String = "prod"
Const lngSuchSpalte As Long = 1
Const lngUebZeilen As Long = 4
For Each rngC In Cells(lngUebZeilen + 1, lngSuchSpalte).Resize( _
Cells(Rows.Count, lngSuchSpalte).End(xlUp).Row - lngUebZeilen)
If UCase$(rngC) = UCase$(strSuchbegr) Then
If rngDel Is Nothing Then
Set rngDel = rngC
Else
Set rngDel = Union(rngDel, rngC)
End If
End If
Next rngC
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
noch eine Variante
14.06.2010 17:55:59
Erich
Hi,
und das noch: 

Sub Zeile_weg_wenn3()
Dim arrQ, strSu As String, zz As Long, rngDel As Range
Const strSuchbegr As String = "prod"
Const lngSuchSpalte As Long = 1
Const lngUebZeilen As Long = 4
arrQ = Cells(lngUebZeilen + 1, lngSuchSpalte).Resize( _
Cells(Rows.Count, lngSuchSpalte).End(xlUp).Row - lngUebZeilen)
strSu = UCase$(strSuchbegr)
For zz = 1 To UBound(arrQ)
If UCase$(arrQ(zz, 1)) = strSu Then
If rngDel Is Nothing Then
Set rngDel = Cells(zz + lngUebZeilen, 1)
Else
Set rngDel = Union(rngDel, Cells(zz + lngUebZeilen, 1))
End If
End If
Next zz
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Makro abändern
15.06.2010 17:10:07
Karin
Hallo Tipp,
supi - es klappt.
Vielen Dank für deine Mühe.
Bis dann.
Liebe Grüße
Karin

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige