Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1916to1920
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Abgleich von Katalogwerten mit Quelle

Abgleich von Katalogwerten mit Quelle
24.01.2023 12:48:47
Katalogwerten
Hi,
ich habe ein Problem mit dem Abgleich von Daten (Katalogwerten) in meiner Quelltabelle. MEin Code funktioniert, ist aber eben relativ langsam und mit Arrays, die hier sicherlich Sinn machen würden) kenne ich mich nicht aus.

int_BerZeile = 8
   
'Quelltabelle
   For a = 3 To Worksheets("LG").Cells(Rows.Count, 2).End(xlUp).Row
      
      'b = Katalogwerte, die in der Tabelle LG abgeglichen werden sollen
      For b = 3 To Worksheets("Refill").Cells(Rows.Count, 11).End(xlUp).Row
         'Wenn der Katalogwert in der Quelltabelle gefunden wird, dann sollen einige Zellen in den "Bericht" kopiert werden.
         If Worksheets("LG").Cells(a, 9) = Worksheets("Refill").Cells(b, 11) Then
            With Worksheets("Bericht")
               .Cells(int_BerZeile, 2) = Worksheets("LG").Cells(a, 3)
               .Cells(int_BerZeile, 3) = Worksheets("LG").Cells(a, 4)
               .Cells(int_BerZeile, 4) = Worksheets("LG").Cells(a, 5)
               .Cells(int_BerZeile, 5) = Worksheets("LG").Cells(a, 6)
               .Cells(int_BerZeile, 6) = Worksheets("LG").Cells(a, 17)
               .Cells(int_BerZeile, 7) = Worksheets("LG").Cells(a, 9)
               int_BerZeile = int_BerZeile + 1
            End With
         End If
      Next b
   Next a
Könnt ihr mir bitte helfen...?
Danke
Jack

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Abgleich von Katalogwerten mit Quelle
24.01.2023 13:09:59
Katalogwerten
Hallo,
teste mal:
Sub jack()
  Dim a As Long, b As Long
  Dim vntOut, arrOut(), tmp
  
  Const cStrDelim As String = "|"
  
  'Quelltabelle
  With Worksheets("LG")
    For a = 3 To .Cells(Rows.Count, 2).End(xlUp).Row
      'b = Katalogwerte, die in der Tabelle LG abgeglichen werden sollen
      For b = 3 To Worksheets("Refill").Cells(Rows.Count, 11).End(xlUp).Row
        'Wenn der Katalogwert in der Quelltabelle gefunden wird, dann sollen einige Zellen in den "Bericht" kopiert werden.
        If .Cells(a, 9) = Worksheets("Refill").Cells(b, 11) Then
          vntOut = vntOut & Join(Array(.Cells(a, 3), .Cells(a, 4), .Cells(a, 5), .Cells(a, 6), .Cells(a, 17), .Cells(a, 9)), cStrDelim) & vbCrLf
        End If
      Next b
    Next a
  End With
  
  If Len(vntOut) Then
    vntOut = Split(vntOut, vbCrLf)
    ReDim arrOut(UBound(vntOut) - 1, 5)
    For a = 0 To UBound(vntOut) - 1
      tmp = Split(vntOut(a), cStrDelim)
      For b = 0 To UBound(tmp)
        arrOut(a, b) = tmp(b)
      Next b
    Next a
    Worksheets("Bericht").Cells(8, 2).Resize(UBound(arrOut) + 1, UBound(arrOut, 2) + 1) = arrOut
  End If
  
End Sub
Gruß
Rudi
Anzeige
AW: Abgleich von Katalogwerten mit Quelle
24.01.2023 13:18:20
Katalogwerten
Hey Rudi,
Respekt... läuft ein VW Käfer :-), richtig klasse.
Vielen Dank dafür.
Den Code ab ..."If Len(vntOut)..:" kapier ich zwar nicht, aber ok :-D
LG Jack
läuft ein VW Käfer
24.01.2023 13:32:32
Rudi
Porsche wär mir lieber ;-)
Den Code ab ..."If Len(vntOut)..:" kapier ich zwar nicht,
wenn was gefunden wurde, wird alles in ein AusgabeArray geschrieben und das anschließend in den Bericht.
Das dürfte die Geschwindigkeit machen.
Gruß
Rudi
AW: läuft ein VW Käfer
24.01.2023 13:35:08
Captain
Natürlich läuft der Code schnell und wie ein Porsche, klar... das war auch eher als Metapher für Verlässlichkeit gedacht.
Danke für die Erklärung
Jack
Anzeige
AW: Abgleich von Katalogwerten mit Quelle
24.01.2023 14:07:37
Katalogwerten
Hi
prinzipell läuft das auch ohne Arrays schnell, wenn man es richtig macht.
ein schneller Weg wäre beispielsweise, erstmal allesim Block zu kopieren und dann die nicht benötigten Zeilen zu löschen.
darin ist Excel ziemlich fix (über Duplikate Entfernen).
int_BerZeile = 8
LGende = Worksheets("LG").Cells(Rows.Count, 2).End(xlUp).Row
'--- Benötigte Spalten kopieren
With Worksheets("LG").Range("A3:Z" & LGende)
    .Columns(3).Resize(, 4).Copy Worksheets("Bericht").Cells(int_BerZeile, 2)
    .Columns(17).Copy Worksheets("Bericht").Cells(int_BerZeile, 6)
    .Columns(9).Copy Worksheets("Bericht").Cells(int_BerZeile, 7)
end with
'--- nicht benötigte Zeilen löschen
With Worksheets("Bericht").Cells(int_BerZeile - 1, 8).Resize(LGende - 1)
    .FormulaR1C1 = "=IF(CountIF(Refill!C11;RC7),Row(),0)""
    .Cells(1, 1) = 0
    .EntireRow.RemoveDuplicates .column, xlno
    .ClearContents
end with
wenn das noch nicht schnell genug ist und die Liste Refill sehr lang ist, dann könnte man noch diesen Turbo dazu schalten:
1. Liste Refill nach Spalte 11 aufsteigend sortieren (möglichst mit einer Zeile Überschrift)
2. diese Formel anstelle von CountIF verwenden, um das vorhanden sein zu prüfen:
.FormulaR1C1 = "=IF(Match(RC7,Refill!C11,1)=RC7,Row(),0)"
Gruß Daniel
ps: mangels Beispieldatei ungetestet

Anzeige
AW: Abgleich von Katalogwerten mit Quelle
24.01.2023 14:34:16
Katalogwerten
HI Daniel,
das ist auch eine sehr interessante Methode, prima. Werde ich ausprobieren.
Auf diese Idee wäre ich tatsächlich nicht gekommen.
Vielen Dank dafür.
LG Jack
AW: Abgleich von Katalogwerten mit Quelle
24.01.2023 14:52:30
Katalogwerten
HI
man könnte das auch anders herum aufziehen:
markiere zuerst in LG in einer Hilfsspalte alle Zeilen, die kopiert werden sollen, und kopiere dann diese
das wäre vielleicht noch einfacher, allerdings dann, wenn die Reihenfolge der Spalten nicht geändert wird:
With Sheets("LG").UsedRange
    with .columns(.columns.Count + 1)
        .FormulaR1C1 = "=IF(CountIF(Refill!C11;RC9),1,"""")"
        if Worksheetfunction.Sum(.Cells) > 0 Then
            Intersect(.SpecialCells(xlcelltypeformulas, 1).EntireRow, Sheets("LG").Range("C:F;I:I,Q:Q")).Copy
            Sheets("Bericht").Cells(8, 2).PasteSpecial xlpasteall
       end if 
    end with
end with
die weitere Beschleunigung durch Sortieren von Refill und der Verwendung von MATCH gilt auch hier.
Gruß Daniel
Anzeige
AW: Abgleich von Katalogwerten mit Quelle
24.01.2023 15:15:14
Katalogwerten
Bislang hatte ich mit Formeln im VBA wenig bis keine Erfahrung, weil sich das für mich irgendwie ausschloss, aber wie ich sehe, eine sehr gute Alternative.
Is schon cool...
Danke schön
Jack
AW: Abgleich von Katalogwerten mit Quelle
24.01.2023 15:33:43
Katalogwerten
Bei der Konstellation Excel gut - VBA bescheiden ist das fast die beste Alternative, weil du dir erstmal überlegen kannst, wie mache ich das am einfachsten und schnellsten in Excel und dann baust du diesen Weg in VBA nach.
Man kann eigentlich alles, was man von Hand in Excel machen kann, auch von VBA ausführen lassen und das meiste davon zeichnet freundlicherweise der Recorder auf.
Will man "reines VBA" programmieren (Arrays und so), dann hat man diese Unterstützung nicht und muss sich das wissen anderweitig anlesen.
Gruß Daniel
Anzeige
AW: Abgleich von Katalogwerten mit Quelle
25.01.2023 10:39:05
Katalogwerten
Guten Morgen Daniel,
danke für Deinen Beitrag und Erklärung.
Ja, sicherlich ist das ein Weg und den werde ich mir auch anschauen. Grundsätzlich finde ich meinen bisher gewählten Weg mit den beiden "For..." schleifen nicht verkehrt, denn der funktioniert ja auch, nur eben relativ langsam, was ja angesichts der unzähligen Zwischenschritte und Prüfungen logisch ist. Und genau in / mit diesem Fall bin ich an der nächsten Schwelle angekommen und muss mich auch gerne mit anderen Mitteln beschäftigen, wie eben Arrays oder auch übergreifenden Formeln vom Sheet zum VBA.
Jack
Viele Ähnlichkeit mit
24.01.2023 15:46:36
Yal
https://www.herber.de/forum/messages/1916979.html
einfach ein Auge drauf werden.
Fast genau dieselbe Fragestellung: es gibt eine feste Liste und eine Aktualisierungsliste. Für jede Element der Aktualisierungsliste muss, falls Element in feste Liste vorhanden, die feste Liste angepasst, falls nicht vorhanden, ergänzt.
VG
Yal
Anzeige
AW: Viele Ähnlichkeit mit
25.01.2023 10:41:20
Captain
Hi Yal,
danke für Deinen Tip und den Link. Kann ich mir leider erst daheim ansehen, da ich mir auf meinen beruflichen PC keine Makrodatei herunterladen kann... meine Behörde hat derartige Anhänge für gefährlich erklärt :-o
Danmke
Jack
AW: Viele Ähnlichkeit mit
25.01.2023 11:31:30
Yal
Effektivität durch Automatisierung war Behörden immer suspekt ;-)
AW: Viele Ähnlichkeit mit
25.01.2023 11:36:19
Captain
nach wie vor und zukunftsorientiertes Handeln noch mehr...*nerv*

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige