Listen abgleichen

[Klaus-Dieter]

Hallo,

die Abweichung in Zeile 5 kann ich nicht erkennen.

[Igelbauer]

Bauch voll, Kopf leer. Sorry
So war das gemeint

[Fennek]

Hallo,

ohne die neuen Dateien gesehen zu haben:

Code:

Sub Igel_abgleich()
Dim DD As Object: Set DD = CreateObject("Scripting.Dictionary")
Dim Ar, Key As String

With Sheets("Peripherie")
    Ar = .Cells(1).CurrentRegion
    
    For i = 2 To UBound(Ar)
        DD(Ar(i, 2) & " " & Ar(i, 3) & " " & Ar(i, 4)) = Ar(i, 9)
    Next i
'    For Each k In DD.keys
'        Debug.Print k, DD(k)
'    Next k
End With

With Sheets("CSV-Export")
     Ar = .Cells(1).CurrentRegion
    
     For i = 2 To UBound(Ar)
        Key = Ar(i, 3) & "/" & Format(Val(Ar(i, 4)), "00") & " " & Ar(i, 1) & " " & Ar(i, 2)
        Debug.Print Key, DD(Key)
        If DD.exists(Key) Then
            If Ar(i, 5) <> DD(Key) Then
                lr = lr + 1
                With Sheets("unregelmässigkeiten")
                    .Cells(lr, 1) = Key
                    .Cells(lr, 2) = DD(Key)
                End With
            End If
        End If
     Next i
End With
End Sub

PS: Umlaute im Sheet.Namen ????

mfg

[Igelbauer]

Hi Fen,
Leider klappt das noch nicht.
geänderte Texte hat es nicht nach Peripherie übertragen.
Dafür habe ich in "unregelmässigkeiten" eine (ich glaube) vollständige Liste der Einträge in der CSV.
Ich tüftel selbst noch ein bisschen, auch an Klaus-Dieters Code. Und in einer halben Stunde hab ich Feierabend.

Dein Code läuft so schnell wie ein Zauberspruch.
Klaus-Dieters Code ist für mich Halblaien leichter nachzuvollziehen.

Mal sehen - ich meld mich morgen wieder.

Und vielen Dank schon mal für die Mühe

P.S. Verzeih mir das "ä" - dahingekritzelte Beispieldatei

Gruss Igel

[Igelbauer]

Moin Leute,
Hab mir jetzt mal die beiden Codes von FEN und Klaus-Dieter in Ruhe angeschaut, getestet,angepasst....
Laufen noch lange nicht so wie sie sollen. Habe aber heute viel anderes zu tun.
Klar ist, dass ich wohl meine Anfrage gestern miserabel formuliert hatte, weil ihr sie beide nicht verstanden habt.
Danke trotzdem für den Versuch einem Halbblinden zu helfen.
Die Sache muss jetzt mal ein paar Tage ruhen, vielleicht kommen noch Detailfragen, aber heute nicht mehr.

Gruss Igel

[snb]

In CSV-export F2

PHP-Code:

=C2&TEXT(D2;"\/00")&A2&B2 


G2

PHP-Code:

=Peripherie!B2&Peripherie!C2&Peripherie!D2 


H2

PHP-Code:

=COUNTIF($G$2:$G$25;F2) 


[Igelbauer]

Hi snb,
Hab jetzt nach der Mittagspause nochmal schnell rein geschaut.
Danke auch an Dich für den Versuch mir zu helfen. Ich hatte aber schon mal erwähnt, dass eine Formellösung für diese Sache nicht in Frage kommt.
Der Ablauf ist folgender: In der BMA wird etwas geändert - Ich ziehe mir einen CSV-Export raus und kopiere das Tabellenblatt in meine grosse BMA-Datei - dann gleiche ich alle Änderungen ab und lösche das CSV-Tabellenblatt wieder.
Die BMA-Datei enthält ALLE Informationen über eine Brandmeldeanlage mit z.Zt. ca. 6500 Meldern. In ihr enthalten ist auch noch ein recht grosser Altbestand, den ich sowieso ganz anders abgleichen muss. Die Pflege dieser Datei ist recht aufwändig und an vielen Stellen versuche ich mir die Arbeit durch das eine oder andere Makro zu erleichtern.
Leider war der Spruch mit dem Halbblinden kein Scherz, sondern eine Übertreibung.
Über 50% Sehkraft wäre ich überglücklich. Das arbeiten am Rechner mit Bildschirmlupe macht nicht wirklich Spass.
Deswegen frag ich schon mal hier um Hilfe, bin aber nicht böse, wenn es nicht fruchtet.
Ich kämpft mich schon irgendwie durch.

So, genug geplaudert.
Nochmal Danke an alle die ihren Kopf für mich angestrengt haben.

Gruss Igel

[Igelbauer]

Moin,
ich nochmal.
Habe den Code von K-D als Grundlage genommen und kräftig modifiziert.
Dabei ist mir endgültig klar geworden wie schlecht meine Beschreibung war.
Will euch das Ergebnis aber nicht vorenthalten.

Code:

Option Explicit
Sub uebertrag()
     Dim lngZeile As Long
     Dim strSuch As String
     Dim zelle As Range
     Dim i As Long
     i = 1
'Suchbegriff festlegen
     For lngZeile = 2 To Sheets("CSV-Export").Range("A1").End(xlDown).Row
      If Sheets("CSV-Export").Cells(lngZeile, 3) <> "" Then
         If Sheets("CSV-Export").Cells(lngZeile, 4) = "" Then
             strSuch = Sheets("CSV-Export").Cells(lngZeile, 3) & "/00"
         ElseIf Len(Sheets("CSV-Export").Cells(lngZeile, 4)) = 2 Then
             strSuch = Sheets("CSV-Export").Cells(lngZeile, 3) & "/"
         Else
             strSuch = Sheets("CSV-Export").Cells(lngZeile, 3) & "/0" & Sheets("CSV-Export").Cells(lngZeile, 4)
         End If
      Else: GoTo weiter
      End If
'suchen
         With Peripherie.Range("B2:B15000")
          Set zelle = .Find(strSuch, LookIn:=xlValues) '.Select
           If zelle Is Nothing Then
            Sheets("unklar").Cells(i, 1) = Sheets("CSV-Export").Cells(lngZeile, 1)
            Sheets("unklar").Cells(i, 2) = Sheets("CSV-Export").Cells(lngZeile, 2)
            Sheets("unklar").Cells(i, 3) = Sheets("CSV-Export").Cells(lngZeile, 3)
            Sheets("unklar").Cells(i, 4) = Sheets("CSV-Export").Cells(lngZeile, 4)
            Sheets("unklar").Cells(i, 5) = Sheets("CSV-Export").Cells(lngZeile, 5)
            i = i + 1
            GoTo weiter
           End If
'Abgleich Objekt,Abschnitt
        If Sheets("CSV-Export").Cells(lngZeile, 1) = Peripherie.Cells(zelle.Row, 3) And _
            Sheets("CSV-Export").Cells(lngZeile, 2) = Peripherie.Cells(zelle.Row, 4) Then
        Else
            Sheets("unklar").Cells(i, 1) = Sheets("CSV-Export").Cells(lngZeile, 1)
            Sheets("unklar").Cells(i, 2) = Sheets("CSV-Export").Cells(lngZeile, 2)
            Sheets("unklar").Cells(i, 3) = Sheets("CSV-Export").Cells(lngZeile, 3)
            Sheets("unklar").Cells(i, 4) = Sheets("CSV-Export").Cells(lngZeile, 4)
            Sheets("unklar").Cells(i, 5) = Sheets("CSV-Export").Cells(lngZeile, 5)
            i = i + 1
            GoTo weiter
        End If
'kein Einzeltext
             If Sheets("CSV-Export").Cells(lngZeile, 5) = "" Then
                Peripherie.Cells(zelle.Row, 9) = Peripherie.Cells(zelle.Row - 1, 9)
'Übertragen
             Else
                Peripherie.Cells(zelle.Row, 9) = Sheets("CSV-Export").Cells(lngZeile, 5)
             End If
         End With
weiter:
     Next lngZeile
 End Sub

so funktioniert er jetzt und braucht ca. 12 Sek. zum durchlaufen.  Kann ich mit leben.
Mit Fenneks Code bin ich gar nicht klar gekommen - bin halt kein Profi.
Trotzdem nochmal danke fürs grübeln

Gruss Igel

[Klaus-Dieter]

Hallo,

zwei Fragen:

1. warum stellst du den Quelltext zeilenweise ein?
2. wo hast du die Arbeit mit GoTo Her? Das wird seit Ewigkeiten nicht mehr praktiziert.

---

Hallo,

Frage 1 ziehe ich zurück. 

[Igelbauer]

Hi,
goto hab ich irgendwo in irgendeinem Code vor Jahren mal gelesen. Manchmal recht nützlich.
Wie macht man das sonst ?