datenlöschen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Main dim rng as range for each Ar in sheets("Auswertung").usedrange.columns(1).specialcells(12).areas if isnumeric( cint(ar)) then for each Sh in Sheets if Sh.name "Auswertung" then set rng = sh.columns(1).find(cint(Ar)) if not rng is nothing then rng.interior.color = vbyellow msgbox rng.address end if end if next Sh end if next Ar End Sub

Sub iFen() Dim rng As Range For Each Ar In Sheets("Auswertung").UsedRange.Columns(1).SpecialCells(12).Areas Debug.Print Ar If IsNumeric(Ar) Then For Each Sh In Sheets If Sh.Name "Auswertung" Then Set rng = Sh.Columns(1).Find(CInt(Ar)) If Not rng Is Nothing Then rng.Interior.Color = vbYellow '#### löschen 'rng.EntireRow.Delete End If End If Next Sh End If Next Ar End Sub

Sub iFen() Dim rng As Range For Each Ar In Sheets("Auswertung").UsedRange.Columns(1).SpecialCells(12).Areas If Ar.Count > 1 Then MsgBox "prüfen: " & Ar: Exit Sub If IsNumeric(Ar) Then For Each Sh In Sheets If Sh.Name "Auswertung" Then Set rng = Sh.Columns(1).Find(CInt(Ar)) If Not rng Is Nothing Then rng.Interior.Color = vbYellow '#### löschen 'rng.EntireRow.Delete End If End If Next Sh End If Next Ar End Sub

Allgemeine Probleme in Foren: 1. Stufe: schlechte Beispieldatei (in deinem Fall "super") 2. Stufe: die FRagestellerin versteht den Code nicht (?) 3. Stufe: der Transfer in die Orinaldatei macht Probleme (sehr häufig)

Option Explicit Sub Hauweg() Dim rng As Range, Ar As Range, Cell As Range, Sh As Object For Each Ar In Sheets("Auswertung").UsedRange.Columns(1).SpecialCells(12).Areas For Each Cell In Ar.Cells If IsNumeric(Cell) Then For Each Sh In Sheets If InStr(1, Sh.Name, "KW") > 0 Then Set rng = Sh.Columns(1).Find(CInt(Cell)) If Not rng Is Nothing Then rng.Interior.Color = vbYellow '#### löschen rng.EntireRow.Delete End If End If Next Sh End If Next Cell Next Ar End Sub

Hi
wenn du alle Artikelnummern löschen willst, die im Blatt "Auswerten" gefiltert sind, dann ggf mit diesem Code:

Sub LöschenGefiltert()
Dim Zelle As Range
Dim FO As String
Dim LöschArtNr As String
Dim sh As Worksheet
'--- zu löschende Art-Nummern in Variable sammeln
For Each Zelle In Sheets("Auswertung").UsedRange.Columns(1).SpecialCells(xlCellTypeVisible). _
Cells
LöschArtNr = LöschArtNr & "|" & CStr(Zelle.Value)
Next
'--- Formel zum Kennzeichnen der zu löschenden Daten erstellen
FO = "=IF(isnumber(find(""|""&RC1&""|"",""" & LöschArtNr & """)),0,Row())"
'--- Schleife über alle Blätter und löschen
For Each sh In ThisWorkbook.Worksheets
If sh.Name Like "KW*" Then
'--- eventuell vorhandenen Autofilter ausschalten
On Error Resume Next
sh.ShowAllData
On Error GoTo 0
'--- Zeilen löschen
With sh.UsedRange
With .Columns(.Columns.Count + 1)
.FormulaR1C1 = FO '--- mit Formel markieren
.Cells(1, 1).Value = 0 '--- in Überschrift muss 0 stehen
.EntireRow.RemoveDuplicates .Column, xlNo '--- Zeilen löschen
.ClearContents '--- Aufräumen
End With
End With
End If
Next
End Sub

beachte, dass die Anzahl der Artikelnummern, die gelöscht werden sollen, hier limitiert ist (sie dürfen zusammen nicht mehr als 1000 Zeichen lang sein)
Wenn du viele Artikelnummern hast die gelöscht werden sollen, müsste man ggf eine anderer Kennezeichnungsformel verwenden.
Müssen es unbedingt die gefilterten Daten sein?
könnte man nicht auch einfach sagen, lösche alle Artkielnummern, bei denen in der Auswertung die Anzahl 0 steht, ohne berücksichtigung der Filterung?
Dann könnte man auch eine einfachere Formel einsetzen, und die Anzahl der zu löschenden Nummern wäre nicht mehr limitiert.´
Ansonsten habe ich das mit deiner Beispieldatei getestet und es funktioniert
Gruß Daniel

Beliebteste Forumthreads (12 Monate)

22 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

22
Beiträge zum Forumthread

Beiträge zu diesem Forumthread