Microsoft Excel

Herbers Excel/VBA-Archiv

Duplikate verwalten via VBA

Betrifft: Duplikate verwalten via VBA von: Michael
Geschrieben am: 24.09.2020 13:58:14

Hallo zusammen,

dies ist mein erster Beitrag, ich hoffe ihr könnt mir helfen. Ich habe zwar schon einige Beiträge im Netz zum Thema Duplikate löschen etc gefunden, jedoch nichts, was mir bei meinem speziellen Fall geholfen hätte.

Die Problematik stellt sich wie folgt dar:

Ich habe eine Tabelle mit Daten diverser Störungen in unserem Betrieb. Die Excel Tabelle erzeuge ich mit einem betrieblichen Programm zur Eingabe von Störungen. Leider gibt es das Programm nicht her, Störungen, die über das Schichtende (3-Schicht-Betrieb, Wechsel jeweils 6 Uhr/ 14 Uhr / 22 Uhr ) hinausgehen, zu einer Störung zusammenzufassen.

Heißt, wenn ich eine Störung über mehrere Schichten habe, wird immer eine neue Zeile ab dem Zeitpunkt "Schichtwechsel" angelegt. Da ich die Störungen statistisch auswerten möchte, würden mir dann bei der Anzahl der Störungen falsche Werte angezeigt werden.

Meine Idee ist jetzt folgende: Ich würde gerne per VBA Code alle Duplikate in Spalte A suchen. Dann soll er mir Die Enduhrzeit in Spalte C des letzten Duplikats in die Spalte C der ersten Zeile (also quasi der Anfangswert) kopieren und dann alle Duplikate löschen. (Ich hoffe, ich habe mich nicht zu kompliziert ausgedrückt)
Hier nochmal als konkretes Beispiel aus der angehängten Excel Datei:

In A127 kommt zum ersten Mal die Störnummer 11770757 vor. Diese zieht sich dann bis A134 durch, da es sich schichtübergreifend um die gleiche Störung handelt.. Jetzt soll Excel das erkennen, den Wert aus C134 kopieren und in C127 einfügen. Danach sollen dann die Zeilen 128 - 134 (also alle Duplikate) gelöscht werden.

Ich bekomme da als einzigen Ansatz bisher hin, dass er mir die Zeilen der Duplikate löscht. Allerdings habe ich überhaupt keinen Ansatz dazu, wie er die Zeile des letzten Duplikates erkennt, um dann die Prozedur mit dem Kopieren/Einfügen auszuführen.

Ich hoffe, Ihr könnt mir helfen. Vielen Dank schonmal dafür.

Viele Grüße

Michael

Anbei noch die Datei mit den entsprechenden Werten. Die Duplikate habe ich einfach mal mit bedingter Formatierung eingefügt:
https://www.herber.de/bbs/user/140404.xlsx

Betrifft: AW: Duplikate verwalten via VBA
von: Armin
Geschrieben am: 24.09.2020 17:27:14

Hallo Michael,
ich habe eine Version erstellt. Zum Start rechte Maustaste in Zelle A1 "Stör-Nr.".
Ich hoffe das die Sache so stimmt.
https://www.herber.de/bbs/user/140415.xlsm

Gruß Armin

Betrifft: AW: Duplikate verwalten via VBA
von: Michael
Geschrieben am: 25.09.2020 11:54:58

Hi Armin,

danke dir, klappt super. Genau das hatte ich mir vorgestellt.

Habe mir mal deinen Code angesehen, da wäre ich im Leben nicht drauf gekommen.

Kannst du den Code eventuell etwas erläutern, lerne gerne immer dazu.

Viele Grüße

Michael

Betrifft: AW: Duplikate verwalten via VBA
von: Armin
Geschrieben am: 25.09.2020 13:00:23

Hallo Michael,
hier der Code mit Kommentaren:

'diese Prozedur reagiert auf rechten Maus-click
Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim K As Long, M As Long
Dim X As Long, L As Long
Dim D As String
Dim STNR As String
Cancel = True

If Target.Address = "$A$1" Then 'prüfen auf Zelle A1
  With Tabelle1
     M = .Cells(Rows.Count, 1).End(xlUp).Row 'wieviel Störungen sind eingetragen
     STNR = .Cells(M, 1).Value 'letzte Störung speichern
     For K = M - 1 To 3 Step -1 'Laufanweisung beginne am ende und dann rückwärts
         If .Cells(K, 1).Value = STNR Then 'stimmen letzte und vorletzte überein?
            X = K 'merke aktuelle Zeile
            If L = 0 Then L = K + 1  'merke die erste Übereinstimmung
         Else 'Nein stimmt nicht überein also andere Nr.
            If X > 0 Then 'prüfe ob es schon eine Übereinstimmung gab
               .Cells(X, 3).Value = .Cells(L, 3).Value 'ja dann schreibe letzten Datum in erste  _
Störung
               If L - X = 1 Then D = CStr(L) Else D = CStr(L) & ":" & CStr(X + 1) 'war es nur  _
eine oder mehrere Zeilen
               Rows(D).Delete Shift:=xlUp 'Zeile oder n-Zeilen löschen
               L = 0
               X = 0
            End If
            STNR = .Cells(K, 1).Value 'nächste Zeile als letzte setzen
         End If
     Next  'nächste Zeile Testen
End With
End If
Application.EnableEvents = True
End Sub
Gruß Armin

Betrifft: AW: Duplikate verwalten via VBA
von: Luschi
Geschrieben am: 25.09.2020 16:09:11

Hallo Michael,

ich habe den Code von Armin noch dahingehend geändert, daß jetzt auch die Gesamtzeit einer Störung berechnet und in Spalte 'D' eingetragen wird.








Code in die Zwischenablage
Microsoft Excel Objekt Tabelle1
Option Explicit 
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean) 
Dim K As Long, M As Long 
Dim X As Long, L As Long, T As Double 
Dim D As String 
Dim STNR As String 
Cancel = True 
 
If Target.Address = "$A$1" Then 
  With Tabelle1 
     M = .Cells(.Rows.Count, 1).End(xlUp).Row 
     STNR = .Cells(M, 1).Value 
     For K = M - 1 To 3 Step -1 
         If .Cells(K, 1).Value = STNR Then 
            X = K 
            T = T + .Cells(K + 1, 4).Value 
            If L = 0 Then L = K + 1 
         Else 
            If X > 0 Then 
               'Zeiten bei mehreren gleichen Störungsnummern addieren 
               T = T + .Cells(X, 4).Value 
               .Cells(X, 4).Value = T 
               .Cells(X, 3).Value = .Cells(L, 3).Value 
               If L - X = 1 Then D = CStr(L) Else D = CStr(L) & ":" & CStr(X + 1) 
               Rows(D).Delete Shift:=xlUp 
               L = 0 
               X = 0 
               T = 0 
            End If 
            STNR = .Cells(K, 1).Value 
            Debug.Print STNR 
         End If 
     Next 
End With 
End If 
Application.EnableEvents = True 
End Sub 
 
Sub MachMal() 
Dim K As Long, M As Long 
Dim X As Long, L As Long, T As Double 
Dim D As String 
Dim STNR As String 
Cancel = True 
 
If Target.Address = "$A$1" Then 
  With Tabelle1 
     M = .Cells(Rows.Count, 1).End(xlUp).Row 
     STNR = .Cells(M, 1).Value 
     For K = M - 1 To 3 Step -1 
         If .Cells(K, 1).Value = STNR Then 
            X = K 
            If L = 0 Then L = K + 1 
         Else 
            If X > 0 Then 
               .Cells(X, 3).Value = .Cells(L, 3).Value 
               If L - X = 1 Then D = CStr(L) Else D = CStr(L) & ":" & CStr(X + 1) 
               .Rows(D).Delete Shift:=xlUp 
               L = 0 
               X = 0 
            End If 
            STNR = .Cells(K, 1).Value 
         End If 
     Next 
End With 
End If 
Application.EnableEvents = True 
End Sub 

Ideengeber: VBA/HTML-CodeConverter

Volti (K-H): Vba-Code in Zwischenablage

Gruß von Luschi
aus klein-Paris


ÄäÖöÜü



Beiträge aus dem Excel-Forum zum Thema "Duplikate verwalten via VBA"