Listen abgleichen

[Igelbauer]

Moin allerseits,
ich brauch mal wieder Hilfe, sonst hack ich mir die Finger wund.
Ich habe eine recht grosse Excel-Datei in der alle Informationen unserer Brandmeldeanlage dokumentiert sind.
Verschiedene Leute nehmen Änderungen an der Anlage vor und diese Änderungen muss ich übernehmen.
Ich kann aus der BMA eine CSV exportieren mit diversen Informationen, die ich dann an meine Datei übertragen muss.
Da die Anlage recht umfangreich ist es manchmal schwierig überhaupt die Unterschiede zu finden.
Nunja, ich hab erst mal eine Bsp.Datei gebastelt in der das Problem grob umrissen wird.
Es gibt wahrscheinlich noch Fragen. Achja, und bitte nur den Code hier posten, weil unsere EDV xlsm blockt.

Igel

[Klaus-Dieter]

Hallo,

bitte testen, ob das so richtig ist.

Code:

Option Explicit

Sub uebertrag()
    Dim lngZeile As Long
    Dim strSuch As String
    Dim lngZiZeile As Long
    Dim zelle As Range
    Dim ersteAdresse As String
    lngZiZeile = 1
    For lngZeile = 2 To Tabelle2.Range("A1").End(xlDown).Row 'strSuch =
        If Tabelle2.Cells(lngZeile, 4) = "" Then
            strSuch = Tabelle2.Cells(lngZeile, 3) & "/00"
        Else
            strSuch = Tabelle2.Cells(lngZeile, 3) & "/0" & Tabelle2.Cells(lngZeile, 4)
        End If
        With Tabelle1.Range("B2:B" & Tabelle2.Range("A1").End(xlDown).Row)
            Set zelle = .Find(strSuch, LookIn:=xlValues)
            If Not zelle Is Nothing Then
                ersteAdresse = zelle.Address
                Do
                    lngZiZeile = lngZiZeile + 1
                    Tabelle3.Cells(lngZiZeile, 1) = Tabelle1.Cells(lngZeile, 3)
                    Tabelle3.Cells(lngZiZeile, 2) = Tabelle1.Cells(lngZeile, 4)
                    Tabelle3.Cells(lngZiZeile, 4) = Tabelle1.Cells(lngZeile, 9)
                    Set zelle = .FindNext(zelle)
                Loop While Not zelle Is Nothing And zelle.Address <> ersteAdresse
            End If
        End With
    Next lngZeile
End Sub

[schauan]

Hallöchen,

Du könntest den CSV-Export mittels Kopieren - Inhalte einfügen - Werte in ein vorbereitetes Blatt einfügen wo entsprechende Formeln vorbereitet sind, die Dir die Arbeit abnehmen. Wäre dann ohne Code möglich ... Die Frage wäre lediglich, was recht groß ist und welche Performance sich bei einer Formellösung dadurch ergibt. Im Prinzip mal so, nur für B & C Abgleich

Arbeitsblatt mit dem Namen 'CSV-Export'
	A	B	C	D	E	F	G	H	I
1	Objekt	Abschnitt	Meldergruppe	Nr.	Text
2	1200	1200	8001		EG BA9 Flur EBZ_69			0	1
3	1200	1200	8001	1	EG BA9 Flur EBZ_69			0	1

Zelle	Formel
I2	=ZÄHLENWENN(Peripherie!B:B;C2&"/"&TEXT(D2;"00"))
I3	=ZÄHLENWENN(Peripherie!B:B;C3&"/"&TEXT(D3;"00"))

Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016

Diese Tabelle wurde mit Tab2Html (v2.7.0) erstellt. ©Gerd alias Bamberg

[Igelbauer]

Hi,
Danke schon mal für die ersten Ideen.
@Klaus-Dieter.  Habe den Code mal ausprobiert (Tabellenblätter mussten angepasst werden).
                       Unterschiede hat er aber nicht abgeglichen und in Tabelle3 hab ich ziemlich unsinnige Einträge  bekommen.
@schauan.  Formel scheidet wohl aus.

[Klaus-Dieter]

Hallo,

jede Antwort und jedes Programm kann nur so gut sein, wie die Anfrage. Habe das, so wie ich es verstanden hatte, an deine Beispieldatei angepasst. Wenn das so nicht funktioniert, musst du wohl noch mal nachliefern.

[Igelbauer]

Ich arbeite dran.
Aber jetzt ist erstmal Mittag

[Fennek]

Hallo,

der erste Teil ist es die Bestandsdaten in ein Dictionary zu laden. Das sollte so gehen:

Code:

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

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
End Sub

Der Vergleich mit den CSV-Daten fehlt noch, aber jetzt ist erst einmal Mittagspause.

mfg

[Igelbauer]

So, frisch gestärkt.
@ Klaus-Dieter.   Hast natürlich recht. Ein paar Kleinigkeiten hab ich jetzt schon ausgebügelt.
Jetzt noch einmal ab dem Punkt wo die Zelle gefunden wurde.
In Peripherie muss der Text(Spalte I ) aus der CSV (Spalte E) übernommen werden.
Dann muss geschaut werden ob Spalten C,D in Peripherie mit A,B in CSV übereinstimmen.
Wenn nicht, dann am Besten Kopie der ganzen Zeile in Tabelle3.
Wenn strsuch nicht gefunden wurde ebenso.
Ich hoffe das ist jetzt besser erklärt.

@Fen Lass dirs schmecken

[Klaus-Dieter]

Hallo,

lade bitte eine Datei mit dem Wunschergebnis hoch.

[Igelbauer]

So noch mal etwas genauer.