Range definieren bestimmte zellen herauslöschen

Hallo,
ich bewundere dieses Forum und habe hier schon zahlreiche Stunden mit Makros lernen und verstehen verbracht. Mittlerweile kann ich auch schon selbst einigermaßen "programmieren" doch bei diesem Projekt versagen meine Kenntnisse total.
In Spalte A habe ich aus einem Warenwirtschaftssystem (so 5000) Artikel die ich auf Lager habe. Kommen neue Artikel hinzu werden die einfach unten dran gehängt. Also Spalte A hat wächst immer weiter. Meine Artikel Lagern in mehreren Regalen.
So jetzt kommt der Kniff ich muss alle Artikel die ich aus einem Regal entnehme aus der Spalte A löschen können. Erfasst werden alle Artikel mit einem Barcodescanner der alle Codes sammelt und mir dann in Spalte B überträgt. jetzt müsste ich alles was in Spalte B ist aus A löschen lassen. Zusätzlich übergibt mir der Scanner den ersten und den letzten Artikel des Regals (also Artkelnr. 12316546 ist nummer eins und Artikelnr. 654968431 ist das letzte).
Das Makro müsste jetzt ein Spalte A die erste Artikelnr. suchen und die letzte und als "Durchsuchundlösch" Range definieren dann müssten alle Codes aus Spalte B in Spalte A gelöscht werden außer der erste und der letzte...
Ich weiß klingt mega komplex und ich steh auch total am Schlauch...
Wäre toll wenn mir jemand helfen könnte....
DANKE!!!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub loesche_zwischen_Erster_Letzter() Dim varErste, varLetzte Dim rngErste As Range, rngLetzte As Range Dim oWS As Worksheet 'Tabelle anpassen Set oWS = Sheets("Tabelle1") With oWS 'erste Zelle mit Nummer Set rngErste = .Range("B2") 'letzte Zelle mit Nummer Set rngLetzte = .Cells(.Rows.Count, 2).End(xlUp) With Application 'Suche Zeile mit erster varErste = .Match(rngErste.Value, oWS.Columns(1), 0) 'Suche Zeile mit letzter varLetzte = .Match(rngLetzte.Value, oWS.Columns(1), 0) End With 'Zeilen gefunden? If IsNumeric(varErste) And IsNumeric(varLetzte) Then 'Daten zwischen erster und letzter If varLetzte - varErste > 1 Then 'Zellen löschen .Range(.Cells(varErste + 1, 1), .Cells(varLetzte - 1, 1)).Delete Shift:=xlUp Else 'keine Daten dazwischen MsgBox "keine Zellen zwischen erster und letzter Nr.", vbExclamation End If Else 'Nummer nicht gefunden MsgBox "Erste und/oder letzte Nr. nicht gefunden!", vbExclamation End If End With End Sub

Sub LoeschenBestandentnahme() Dim Code1, Code2, Zeile1 As Long, Zeile2 As Long, Zeile As Long Dim rngLoeschen As Range, rng1 As Range, rng2 As Range, Zelle As Range Dim bolGeloescht As Boolean Zeile1 = 1 'Zeile mit 1. Code in Spalte B Code1 = Cells(Zeile1, 2).Value '1. nicht zu löschender Code in Spalte B Zeile2 = Cells(Rows.Count, 2).End(xlUp).Row 'Spalte B, letzte Zeile Code2 = Cells(Zeile2, 2).Value '2. nicht zu löschender Code in Spalte B 'Werte in Spalte A suchen Set rng1 = Columns(1).Find(what:=Code1, LookIn:=xlValues, lookat:=xlWhole) Set rng2 = Columns(1).Find(what:=Code2, LookIn:=xlValues, lookat:=xlWhole) If rng1 Is Nothing Or rng2 Is Nothing Then MsgBox "Code 1 """ & Code1 & """ oder Code 2 """ & Code2 & """ in Spalte A nicht gefunden!" _ Else Set rngLoeschen = Range(rng1, rng2) Application.ScreenUpdating = False For Zeile = Zeile1 + 1 To Zeile2 - 1 Set Zelle = rngLoeschen.Find(what:=Cells(Zeile, 2).Value, LookIn:=xlValues, lookat:= _ xlWhole) If Zelle Is Nothing Then If MsgBox("Code """ & Cells(Zeile, 2).Value & """ in Spalte A nicht gefunden!", _ vbRetryCancel) = vbCancel Then GoTo weiter: Else Zelle.ClearContents bolGeloescht = True End If Next weiter: 'leere Zellen löschen If bolGeloescht = True Then Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)) _ .Cells.SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp End If Application.ScreenUpdating = True End If End Sub

Hallo,
keine Ahnung welche Version Du meinst, hier für meine zum testen.

Sub loesche_zwischen_Erster_Letzter()
Dim varErste, varLetzte
Dim rngErste As Range, rngLetzte As Range
Dim oWS As Worksheet

'Tabelle anpassen 
Set oWS = Sheets("Tabelle1")

With oWS
    'erste Zelle mit Nummer 
    Set rngErste = .Range("B2")
    'letzte Zelle mit Nummer 
    Set rngLetzte = .Cells(.Rows.Count, 2).End(xlUp)


    With Application
        'Suche Zeile mit erster 
        varErste = .Match(rngErste.Value, oWS.Columns(1), 0)
        'Suche Zeile mit letzter 
        varLetzte = .Match(rngLetzte.Value, oWS.Columns(1), 0)
    End With
    
    'Zeilen gefunden? 
    If IsNumeric(varErste) And IsNumeric(varLetzte) Then
        
        'Daten zwischen erster und letzter 
        If varLetzte - varErste > 1 Then
            'Zellen löschen 
            .Range(.Cells(varErste + 1, 1), .Cells(varLetzte - 1, 1)).Delete Shift:=xlUp
        Else
            'keine Daten dazwischen 
            MsgBox "keine Zellen zwischen erster und letzter Nr.", vbExclamation
        End If
    Else
        'Nummer nicht gefunden 
        MsgBox "Erste und/oder letzte Nr. nicht gefunden!", vbExclamation
    End If
    
    'erste gefunden? 
    If IsNumeric(varErste) Then
        'Daten vor erster? 
        If varErste > 2 Then
            .Range(.Cells(2, 1), .Cells(varErste - 1, 1)).Delete Shift:=xlUp
        Else
            MsgBox "Keine Zelle vor erster Nr.", vbExclamation
        End If
    Else
        MsgBox "Erste Nr. nicht gefunden!", vbExclamation
    End If
    
    'letzte gefunden 
    If IsNumeric(varLetzte) Then
        'Suche Zeile mit letzter 
        varLetzte = Application.Match(rngLetzte.Value, oWS.Columns(1), 0)
        'Daten nach letzter? 
        If varLetzte < .Rows.Count Then
            .Range(.Cells(varLetzte + 1, 1), .Cells(.Rows.Count, 1)).Delete Shift:=xlUp
        Else
            MsgBox "Keine Zelle nach letzter Nr.", vbExclamation
        End If
    Else
        MsgBox "Letzte Nr. nicht gefunden!", vbExclamation
    End If

End With

End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

	A	B
1	Artikel Nr.	von Scanner
2	11111111	41111111
3	21111111	51111111
4	31111111	61111111
5	41111111	71111111
6	51111111	81111111
7	61111111	91111111
8	71111111	101111111
9	81111111
10	91111111
11	101111111
12	111111111
13	121111111

Range definieren bestimmte zellen herauslöschen

20
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

321 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Range definieren bestimmte zellen herauslöschen

20 Beiträge zum Forumthread Beiträge zu diesem Forumthread

321 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

20
Beiträge zum Forumthread

Beiträge zu diesem Forumthread