Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema ListBox
BildScreenshot zu ListBox ListBox-Seite mit Beispielarbeitsmappe aufrufen

Vergleichen und löschen von doppelten Einträgen

Betrifft: Vergleichen und löschen von doppelten Einträgen von: Dusan
Geschrieben am: 03.11.2014 11:53:28

Hallo Excel/VBA Experten,

ich habe mir eine Aufgabe gestellt, und mit meinen VBA - Grundkenntnissen komme ich nicht weit vorran. Daher wende ich mich hier an euch.

So sieht die Aufgabenstellung (eine Bsp datei ist hochgeladen):
Bsp Datei: https://www.herber.de/bbs/user/93500.xlsm

1. Wenn ich auf Button "Aktualisieren" klicke, soll eine UserForm geöffnet werden. Dieses klappt es.

2. In der UserForm habe ich eine Liste mit allen Datenblättern aus der Datei. Dies funktionert auch.

3. Nächster Schritt soll es sein (hier bin ich stehen geblieben):
3.1. Aus der Liste ein Datenblatt(Monat) auswählen und diesen bearbeiten (mit Schaltfläche "Filtern"). Dieses Bearbeiten soll so aussehen:
Zellen unter "Auftr.-Nr" (Spalte A) aus dem ausgewählten Datenblatt sollen mit Zellen (Spalte A) aus vorherigen Datenblättern vergliechen werden. Falls es eine Übereinstimmung geben sollte, dann soll komplette Zeile aus dem ausgewählten Datenblatt gelöscht werden. z.B. Im Datenblatt "Okt" habe ich in der Zelle A5 "80654211". Dieses gibt es auch im Datenblatt "Sep" in der Zelle A5. D.h. Zeile 5 im Datenblatt "Okt" löschen.
Ich will mit diesem "Filtern" Datenblätter so bearbeiten, dass ich keine doppelte Eingaben drinnen habe.

Ich hoffe, dass einer hier mir weiter helfen kann. Viel Dank im Voraus und eine erfolgreiche Woche! :)

  

Betrifft: AW: Vergleichen und löschen von doppelten Einträgen von: fcs
Geschrieben am: 03.11.2014 13:17:36

Hallo Dusan,

hier mal ein entsprechendes Makro für die Schaltfläche im Userform, das du ggf. noch ein wenig weiter entwickeln musst.

Gruß
Franz

Private Sub CommandButton1_Click()
  Dim wksGewaehlt As Worksheet
  Dim wksVergleich As Worksheet
  Dim Zeile_A As Long
  Dim rngSuche As Range, rngVergleich As Range, strNr As String
  
  
  If Me.ListBox1.ListIndex = -1 Then
    MsgBox "Bitte erst einen Monat in der Listbox auswählen!"
    Exit Sub
  End If
  
  Set wksGewaehlt = ActiveWorkbook.Worksheets(Me.ListBox1.Value)
  Set wksVergleich = ActiveWorkbook.Worksheets(wksGewaehlt.Index - 1)
  
  If MsgBox("Blatt """ & wksGewaehlt.Name & """ vergleichen mit Blatt """ _
      & wksVergleich.Name & """?", _
      vbOKCancel, "Blatt-Vergleich") = vbCancel Then Exit Sub
      
  With wksVergleich
      Set rngVergleich = .Range(.Cells(5, 1), .Cells(.Rows.Count, 1).End(xlUp))
  End With
  
  With wksGewaehlt
    For Zeile_A = .Cells(.Rows.Count, 1).End(xlUp).Row To 5 Step -1
      strNr = .Cells(Zeile_A, 1)
      
      Set rngSuche = rngVergleich.Find(What:=strNr, LookIn:=xlValues, lookat:=xlWhole)
      If Not rngSuche Is Nothing Then
        If MsgBox("Zeile " & Zeile_A & " löschen?", vbOKCancel, "Zeile-Löschen") = vbOK Then
          .Rows(Zeile_A).Delete shift:=xlShiftUp
        End If
      End If
    Next
    
  End With
End Sub



  

Betrifft: AW: Vergleichen und löschen von doppelten Einträgen von: Dusan
Geschrieben am: 03.11.2014 15:14:34

Hallo Franz,

erstmal viel Dank für schnelle Antwort. Zweitens, nochmal Danke dass es so geil funktioniert. Ich werde es weiter optimieren. :)

Schönen Tag noch!


  

Betrifft: AW: Vergleichen und löschen von doppelten Einträgen von: Dusan
Geschrieben am: 05.11.2014 08:50:14

Guten Morgen Leute,

ich habe versucht Franz-Code ein bisschen zu erweitern und es ist mir teilweise gelunden. Anbei Version mit dem erweiterten Code: https://www.herber.de/bbs/user/93554.xlsm

Wie man sehen kann, ich habe mit einer For-Schleife geschafft, alle vorherige Blätter mit dem aktuellen Blatt zu vergleichen. Nun, ich stoße auf zwei Probleme:

1. Nach dem das Vergleichen und Löschen mit dem letzten Blatt fertig ist, kriege ich diese Meldung:
"Laufzeitfehler '9':
Index außerhalb des gültigen Bereichs"
Ich blicke zur Zeit nicht durch, wo es hackt. Sieht vllt einer das Problem?

2. Ich möchte eigentlich andersrum verleichen. Spricht, Wenn ich "Nov" auswähle, dann soll es erstmal mit "Sep" vergliechen werden. Dann mit "Okt". Wenn ich in der For-Schleife die Bedingungen andersrum schreibe, klappt es nicht und es kommt direkt die Fehlermeldung von dem Problem 1. Hat hier jemand ein Vorschlag wie es funktioniert kann?

Hier der Code:

Private Sub CommandButton1_Click()
  Dim wksGewaehlt As Worksheet
  Dim wksVergleich As Worksheet
  Dim Zeile_A As Long
  Dim rngSuche As Range, rngVergleich As Range, strNr As String
  Dim T As Integer
  
  If Me.ListBox1.ListIndex = -1 Then
    MsgBox "Bitte erst einen Monat in der Listbox auswählen!"
    Exit Sub
  End If

  For T = Me.ListBox1.ListIndex To 0 Step -1
    Set wksGewaehlt = ActiveWorkbook.Worksheets(Me.ListBox1.Value)
    Set wksVergleich = ActiveWorkbook.Worksheets(T)
    
    If MsgBox("Blatt """ & wksGewaehlt.Name & """ vergleichen mit Blatt """ _
        & wksVergleich.Name & """?", _
        vbOKCancel, "Blatt-Vergleich") = vbCancel Then Exit Sub
        
    With wksVergleich
        Set rngVergleich = .Range(.Cells(5, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    
    With wksGewaehlt
      For Zeile_A = .Cells(.Rows.Count, 1).End(xlUp).Row To 5 Step -1
        strNr = .Cells(Zeile_A, 1)
        
        Set rngSuche = rngVergleich.Find(What:=strNr, LookIn:=xlValues, lookat:=xlWhole)
        If Not rngSuche Is Nothing Then
          If MsgBox("Zeile " & Zeile_A & " löschen?", vbOKCancel, "Zeile-Löschen") = vbOK Then
            .Rows(Zeile_A).Delete shift:=xlShiftUp
          End If
        End If
      Next
    End With
  Next
End Sub



  

Betrifft: AW: Vergleichen und löschen von doppelten Einträgen von: fcs
Geschrieben am: 05.11.2014 10:00:03

Hallo Dusan,

du musst in der For-Next-Schleife bei 0 beginnen und bis vor die Index-Nr des gewählten Eintrags hochzählen.
Beim Setzen des Vergleichsblattes musst du entweder die List-Eigenschaft der Listbox verwenden oder mit T+1 arbeiten, da die Index-Nr. der Einträge in der Listbox nicht mit der Index-Nr. der Tabellenblätter übereinstimmt.

Der IndexListboxeinträge beginnen bei 0, die Index-Nr. der Tabellenblätter bei 1. Deshalb auch die Fehlermeldung, wenn in der Schleife der Zähler T den Wert 0 hat.

Gruß
Franz

  For T = 0 To Me.ListBox1.ListIndex - 1
    Set wksGewaehlt = ActiveWorkbook.Worksheets(Me.ListBox1.Value)
    Set wksVergleich = ActiveWorkbook.Worksheets(Me.ListBox1.List(T, 0))



'oder
  For T = 0 To Me.ListBox1.ListIndex - 1
    Set wksGewaehlt = ActiveWorkbook.Worksheets(Me.ListBox1.Value)
    Set wksVergleich = ActiveWorkbook.Worksheets(T + 1)
Gruß
Franz


  

Betrifft: AW: Vergleichen und löschen von doppelten Einträgen von: Dusan
Geschrieben am: 05.11.2014 14:38:46

Hallo Franz,

danke für die Erklärung. In Zwischenzeit bin ich selber darauf gekommen. :) Nur, war mit anderen Sachen abgelehnt und nicht gesehen dass du geschrieben hast. Habe den nächsten Schritt, den ich machen möchte, gerade gepostet. :)

Schönen Tag noch!


  

Betrifft: Problem selber gelöst. Angriff auf nächstes von: Dusan
Geschrieben am: 05.11.2014 14:35:46

Die letzten 2 probleme habe ich geschafft selber zu lösen. Und zwar indem ich For-Schleife so umgeschrieben:
For T = 1 To Me.ListBox1.ListIndex
Soll mit 1 anfangen und dann ist alles OK. :)

Nun, jetzt möchte ich Datei weiter entwickeln, dass sie noch weitere coole Sachen machen kann. Hier die jetzt aktuelle Datei: https://www.herber.de/bbs/user/93564.xlsm

Aufgabenstellung sieht wie folgt aus:

Ich habe jetzt einen zusätzlichen Datenblatt, "MW20141105". Dieser wird dann in der Userform im ListBox3 aufgenommen. Im ListBox2 sind alle Datenblätter mit Monatsnamen drinnen. Der Voragang ist dann wie folgt:
Man wählt ein Monat per Klick aus dem ListBox2 aus, wählt Daatenblatt "MW20141105" aus dem ListBox3 aus und klickt dann auf "Vergleichen". Dieses soll folgendes erzeugen:
Es werden wieder Zellen aus Spalte A von ausgewählten Datenblätter vergliechen. Falls es eine Übereinstimmung gibt, dann sollen Daten aus in den Monatsblatt kopiert werden. Hier ein Bsp.:
Vergleich "Nov" mit "MW20141105". Zelle A5 ("Nov") ist gleich mit Zelle A2 ("MW20141105"). Dann kopieren Zellen B2, C2, D2, E2 und F2 von "MW20141105" in die Zellen K5, L5, M5, N5 und O5 von "Nov". Inhalte von Zellen G2, H2, I2, J2, K2 ("MW20141105") sollen zusammengefügt werden und in die Zelle P5 reingeschrieben. Dann haben wir Zelle A5 ("Nov") mehrmals in der Liste "MW20141105. In diesem Fall soll für das zweite Befund (Zelle A14 in "MW20141105") eine neue Zeile hinter der Zeile 5 im "Nov" eingefugt und auf gleiche Weise dann die Daten kopiert. Und für jedes nächstes Befund eine neue Zeile drunter. Spricht, in diesem Bsp Zelle A5 gibt es 3 mal im Blatt "MW20141105", dann müssen 2 zusätzlichen Zeilen unter der Zelle A5 eingefügt werden und 3 Mal Daten kopiert.

Für mich ist diese eine sehr anspruchsvolle Aufgabe, aber vllt gibt es einen oder anderen hier, der weißt wie es geht. :)

Viel Dank im Voraus!


  

Betrifft: AW: Problem selber gelöst. Angriff auf nächstes von: fcs
Geschrieben am: 06.11.2014 13:13:20

Hallo Dusan,

da sind jetzt jede Menge zusätzliche Prüfschritte erforderlich und die die Arti-Nr im MW-Blatt müssen in 2 geschachtelten For-Next-Schleifen abgearbitet werden, um die Mehrfachnummern korrekt zu erfassen.

Gruß
Franz

Private Sub CommandButton2_Click()
  'Vergleich MW-Blatt mit Monat
  Dim wksMW As Worksheet, arrMW() As Boolean
  Dim wksMonat As Worksheet
  Dim Zeile_MW As Long, Zeile_MW2 As Long, Zeile_MW_L As Long
  Dim Zeile_Monat As Long
  Dim rngSuche As Range, rngVergleich As Range
  Dim strNr As String, strP As String, SpalteMW As Long
  
  If Me.ListBox2.ListIndex = -1 Then
    MsgBox "Bitte erst einen Monat in der Listbox auswählen!", , _
            "Vergleich Monat-MW-Blatt"
    Exit Sub
  End If
  If Me.ListBox3.ListIndex = -1 Then
    MsgBox "Bitte erst einen MW-Blatt in der Listbox auswählen!", , _
           "Vergleich Monat-MW-Blatt"
    Exit Sub
  End If

    Set wksMonat = ActiveWorkbook.Worksheets(Me.ListBox2.Value)
    Set wksMW = ActiveWorkbook.Worksheets(Me.ListBox3.Value)
    
    If MsgBox("Blatt """ & wksMW.Name & """ vergleichen mit Blatt """ _
        & wksMonat.Name & """?", _
        vbOKCancel, "Blatt-Vergleich Monat-MW") = vbCancel Then Exit Sub
        
    
    With wksMW
      'letzte Datenzeile in Spalte A des MW-Blattes
      Zeile_MW_L = .Cells(.Rows.Count, 1).End(xlUp).Row
      'Array für Bearbeitungsstatus anlegen
      ReDim arrMW(2 To Zeile_MW_L)
      'Zeilen im MW-Blatt abarbeiten
      For Zeile_MW = 2 To Zeile_MW_L
        'prüfen, ob Auftr-Nr. schon übertragen
        If arrMW(Zeile_MW) = False Then
          strNr = .Cells(Zeile_MW, 1).Text
          'Datenbereich mit Auftragsnummern im Monatsblatt
          With wksMonat
            Set rngVergleich = .Range(.Cells(5, 1), .Cells(.Rows.Count, 1).End(xlUp))
          End With
          
          'Auftragsnummer im Monatsblatt suchen
          Set rngSuche = rngVergleich.Find(What:=strNr, LookIn:=xlValues, _
                  lookat:=xlWhole)
          
          If Not rngSuche Is Nothing Then
            Zeile_Monat = rngSuche.Row
            'Zeilen bis zum Listenende im MW nach der Auftr-Nr durchsuchen
            For Zeile_MW2 = Zeile_MW To Zeile_MW_L
              If .Cells(Zeile_MW2, 1).Text = strNr Then
                If Zeile_MW2 > Zeile_MW Then
                  'Leerzeile einfügen
                  Zeile_Monat = Zeile_Monat + 1
                  wksMonat.Rows(Zeile_Monat).Insert shift:=xlShiftDown
                  'wksMonat.Cells(Zeile_Monat, 1).Value = strNr 'Art-Nr eintragen
                End If
                'Zellen B bis F in Zeile nach Monatsblatt Spalte K:O kopieren
                .Range(.Cells(Zeile_MW2, 2), .Cells(Zeile_MW2, 6)).Copy _
                     wksMonat.Cells(Zeile_Monat, 11)
                'Text in Zellen G bis K zusammenfassen
                strP = .Cells(Zeile_MW2, 7).Text
                For SpalteMW = 8 To 11
                  strP = strP & " " & .Cells(Zeile_MW2, SpalteMW).Text
                Next
                'Text in Spalte P des Monatsblatt eintragen
                wksMonat.Cells(Zeile_Monat, 16).Value = strP
                arrMW(Zeile_MW2) = True 'Zeile in MW-Blatt als bearbeitet merken
              End If
            Next
          End If
        End If
      Next
    End With
End Sub



 

Beiträge aus den Excel-Beispielen zum Thema "Vergleichen und löschen von doppelten Einträgen"