2 Arrays prüfen und neu zusammenfügen

[Vulkanier]

n'abend Leute,
Meine Situation ist wie folgt, ich lese 2 arrays ein.

Code: Alles auswählen

'Array-1
With Workbooks("Kunden.xlsm").Worksheets(1)
rletzte = .Cells(Rows.Count, 1).End(xlUp).Row
arrtmp1 = .Range(.Cells(2, 1), .Cells(rletzte, 2))
End With
'+++++++++++++++++++++++++
'Array-2
With Workbooks("artikel.xlsm").Worksheets(1)
rletzte = .Cells(Rows.Count, 1).End(xlUp).Row
arrtmp = .Range(.Cells(2, 1), .Cells(rletzte, 10))


Array-1: 2Spalten einer Tabelle mit KundenNr. und KundenName
Array-2: 10Spalten einer Tabelle mit Kundennr. und weiteren Daten (Array-2 hat mehr Datensaetze als Array-1)
Nun möchte ich die 2 Arrays miteinander prüfen, wenn in Array-2 die gleiche KundenNr. gefunden wird soll diese durch den KundenNamen von Array-1 ersetzt werden
Anschliessend soll das Array-2 neu zusammengefügt werden, 1Spalte KundenNamen und 9Spalten mit weiteren Daten.

Könnt Ihr mir mit der umsetzung helfen.

LG

[HKindler]

Hi,

ich halte das Ersetzen der Kundennummern durch Namen für keine gute Idee. Dann dadurch hast du nachher in deiner Spalte eine Mixtur aus Nummern und Namen. Das ist eine Katastrophe! Und was machst du, wenn du zwei verschiedene Peter Müller in deiner Datei hast? Daher: Behalte die Kundennummer auf alle Fälle bei und füge in deinem zweiten Blatt eine zusätzliche Spalte für den Namen ein.

Dort trägst du dann die Formel =WENNFEHLER(SVERWEIS(A2;[Kunden.xlsm]Tabelle1!$A$2:$B$100;2;FALSCH);"nicht vorhanden") ein und ziehst diese runter.

Da VBA nicht wirklich auf einen effizienten Umgang mit Arrays ausgelegt ist, sondern Arrays immer nur in Schleifen behandeln kann, ist so ein Vorgehen auch dafür sinnvoll. Zeichne es einfach mit dem Makrorecorder auf und du hast ein nettes Grundgerüst für eine Routine. Am Schluss list du dann das Ergebnis als Array2 ein.

[snb]

Code: Alles auswählen

Sub M_snb()
    sn = Workbooks("Kunden.xlsm").Sheets(1).Cells(1).CurrentRegion.Resize(, 2)
    sp = Workbooks("artikel.xlsm").Sheets(1).Cells(1).CurrentRegion.Resize(, 11)
   
    With CreateObject("scripting.dictionary")
       For j = 2 To UBound(sn)
          .Item(sn(j, 1)) = sn(j, 2)
       Next
       For j = 2 To UBound(sp)
          sp(j, 11) = .Item(sp(j, 1))
       Next
    End With
   
    Workbooks("artikel.xlsm").Sheets(1).Cells(1).CurrentRegion.Resize(, 11) = sp
End Sub

[Vulkanier]

Hallo,
ich habe mein ziel

Anschliessend soll das Array-2 neu zusammengefügt werden, 1Spalte KundenNamen und 9Spalten mit weiteren Daten.

leider falsch beschrieben ; sorry
Ich möchte gern den neuen array wie folgt:
1Spalte Kundennr.(von Array-2) 2Spalte (der passende) KundenNamen(von Array-1) zur Kundennummer von Array-2 und 9Spalten mit weiteren Daten.

könntet Ihr mir zeigen wie der code dahingehend angepasst werden kann?

LG

[HKindler]

Hallo Mr. Vulkanier,

dann mach doch das, was ich vorgeschlagen habe. Zeichne es mit dem Makroeditor auf und nach etwas Überarbeitung (Select & Co. entfernen, dynamisieren etc.) hast du dein Makro.

Du kannst das aufgezeichnete Makro auch gerne hier hoch laden, falls du Schwierigkeiten mit dem Überarbeiten hast.

[snb]

Code: Alles auswählen

Sub M_snb()
  sn = Workbooks("Kunden.xlsm").Sheets(1).Cells(1).CurrentRegion.Resize(, 2)
  sp = Workbooks("artikel.xlsm").Sheets(1).Cells(1).CurrentRegion.Resize(, 11)
       
  With CreateObject("scripting.dictionary")
    For j = 2 To UBound(sn)
      .Item(sn(j, 1)) = sn(j, 2)
    Next
    For j = 2 To UBound(sp)
      sp(j, 11) = .Item(sp(j, 1))
    Next
  End With
       
  Workbooks("artikel.xlsm").Sheets(1).Cells(1).CurrentRegion.Resize(, 11).offset(,20) = application.index(sp,[row(1:400)],array(1,11,2,3,4,5,6,7,8,9,10))
End Sub

[Vulkanier]

Hallo,
@snb
bin leider erst heute dazu gekommen deinen code zu testen.
Allerdings macht der code nicht ganz was er soll
Soll:
Wenn Tabelle"Artikel-Spalte2"=TabelleKunde-Spalte1" dann soll in Tabelle"Artikel" eine neue Spalte zwischen 1 und 2 eingefügt werden mit dem inhalt vonTabelle"Kunde-Spalte2"
(Prüfung:

IF Tabelle"Kunde.Kdnr.(Spalte1)"=Tabelle"Artikel.Kdnr.(spalte1)" then
Tabelle"Artikel.neueSpalte" = Tabelle"Kunde-Kdname"(spalte2)
End IF

In deinem neu erzeugten Array müsste der 2.wert (11) dann den Kd.Namen von Tabelle"Kunde-Spalte2" in abhängigkeit von Tabelle"Artikel-Spalte1" enthalten.
Könntest du mir zeigen wie man das anpassen kann?

LG

[snb]

Wo ist deine Bespieldatei mit eingetragene Wünschergebnis ?

[Vulkanier]

Hallo,
Test datei im Anhang, mit Wunsch zettel.
LG

[1Matthias]

Moin!
Ich hätte mal snb's Code ein wenig abgeändert. In seiner Variante müsstest du die Zeile mit dem application.index an die .list eigenschaft zuweisen. Das gibt bei der Variante aber das Problem, dass es dann 400 Zeilen in der LB sind. Man könnte jetzt das im INdex anpassen (geht m.W. aber nur über emulate). HAbe deshalb am Anfang eine Spalte B hinzugefügt, dann den Bereich ausgelesen und die Spalte wieder gelöscht. Damit hat man schon die erforderlichen Spalten. Die Einträge kann man so direkt in die betreffende Spalte schreiben und sparrt Index.
Einfach mal testen.

Code: Alles auswählen

Option Explicit
Private Sub UserForm_Initialize()
'On Error GoTo fehler
Dim rletzte As Long
Dim lngIndex As Long, temp
Dim sn, sp, j
Dim rng As Range
'Fenster ganzer Bildschirm
Me.Top = Application.Top
Me.Left = Application.Left
Me.Height = Application.Height
Me.Width = Application.Width
'******************************************

 sn = Workbooks("Kunden.xlsx").Sheets(1).Cells(1).CurrentRegion.Resize(, 2)
 Workbooks("artikel.xlsm").Sheets(1).Columns(2).Insert
  sp = Workbooks("artikel.xlsm").Sheets(1).Cells(1).CurrentRegion.Resize(, 11)
  Workbooks("artikel.xlsm").Sheets(1).Columns(2).Delete
 
 
  With CreateObject("scripting.dictionary")
    For j = 2 To UBound(sn)
      .Item(sn(j, 1)) = sn(j, 2)
    Next
    For j = 2 To UBound(sp)

      sp(j, 2) = .Item(sp(j, 3))
    Next
  End With

        With ListBox1
            .Clear
            .ColumnHeads = False
            .ColumnCount = 14
            .ColumnWidths = "1cm;1cm;5cm;5cm;5cm;2cm;0cm;0cm;0cm;0cm;0cm;0cm;0cm;0cm"
            .ListWidth = "26cm"
            .List = sp

        End With

With ActiveWindow
 .WindowState = xlMaximized
End With
'ListBox2.Clear
lbl_DSgefunden = ListBox1.ListCount
Exit Sub
fehler:
MsgBox "Error in: " & ActiveSheet.Name & Chr(10) & "Division: Sub Userform_initialize" & vbCrLf & "Fehlernummer: " & Err.Number & _
    vbCrLf & "Fehlerbeschreibung: " & Err.Description
End Sub

VG

[Vulkanier]

Hallo,
vielen Dank für die anpassung von @snb seinem code.
Es funktioniert.
Wie müsste ich den code anpassen um die erste zeile (Lfd.Nr.; ArtName; usw...) nicht mit anzuzeigen?
LG

[1Matthias]

Moin!
Da müsstest du am Anfang das Array sp anders dimensionieren und dann nochmal die Schleife beim Eintragen der Namen. Habe das mal geändert und im Sinne von snb als Einzeiler gelassen.

Code: Alles auswählen

Option Explicit
Private Sub UserForm_Initialize()
'On Error GoTo fehler
Dim rletzte As Long
Dim lngIndex As Long, temp
Dim sn, sp, j
Dim rng As Range
'Fenster ganzer Bildschirm
Me.Top = Application.Top
Me.Left = Application.Left
Me.Height = Application.Height
Me.Width = Application.Width
'******************************************

 sn = Workbooks("Kunden.xls").Sheets(1).Cells(1).CurrentRegion.Resize(, 2)
 Workbooks("artikel.xls").Sheets(1).Columns(2).Insert
  sp = Workbooks("artikel.xls").Sheets(1).Cells(2, 1).Resize(Workbooks("artikel.xls").Sheets(1).Cells(1).CurrentRegion.Rows.Count - 1, 11)

  Workbooks("artikel.xls").Sheets(1).Columns(2).Delete
 
 
  With CreateObject("scripting.dictionary")
    For j = 2 To UBound(sn)
      .Item(sn(j, 1)) = sn(j, 2)
    Next
    For j = 1 To UBound(sp)

      sp(j, 2) = .Item(sp(j, 3))
    Next
  End With

        With ListBox1
            .Clear
            .ColumnHeads = False
            .ColumnCount = 14
            .ColumnWidths = "1cm;1cm;5cm;5cm;5cm;2cm;0cm;0cm;0cm;0cm;0cm;0cm;0cm;0cm"
            .ListWidth = "26cm"
            .List = sp

        End With

With ActiveWindow
 .WindowState = xlMaximized
End With
'ListBox2.Clear
lbl_DSgefunden = ListBox1.ListCount
Exit Sub
fehler:
MsgBox "Error in: " & ActiveSheet.Name & Chr(10) & "Division: Sub Userform_initialize" & vbCrLf & "Fehlernummer: " & Err.Number & _
    vbCrLf & "Fehlerbeschreibung: " & Err.Description
End Sub

VG

[Vulkanier]

Mahlzeit,
vielen Dank für deine Hilfe, so läufts es.
Ist zu guter letzt auch noch eine Sortierung nach der 2. Spalte möglich

LG

[snb]

Man sollte
- die Artikel Datei als .xlsb speichern
- die Kunden Datie irgendwo speichern
- die Listbox Eigenschaften im Entwurf Modus speichern

Dann reicht:

Code: Alles auswählen

Private Sub UserForm_Initialize()
  sn = Tabelle1.Cells(1).CurrentRegion
  With GetObject("G:\OF\Kunden.xlsx")
    sp = .Sheets(1).Cells(1).CurrentRegion
    st = .Sheets(1).Cells(1).CurrentRegion.Columns(1)
    .Close 0
  End With
   
  For j = 2 To UBound(sn)
    sn(j, 2) = sp(Application.Match(sn(j, 2), st, 0), 2)
  Next
   
  ListBox1.List = sn
End Sub

[Vulkanier]

Hallo,
vielen dank für deine Mühe.
Kann man den code noch anpassen, das die Key-Spalte erhalten bleibt und die Spalte KundenName daneben eingefügt wird.
Weiterhin wäre eine Sortierung nach KundenName sehr schön.

LG