Übernahme von Zellinhalten

[sunny01]

Hallo,

ich habe ein Problem bei der Übernahme von Zellinhalten zwischen Tabellen (siehe Datei als Anlage). Ich möchte gerne einen Abgleich von Einträgen mit derselben Nummer zwischen Tabellen einrichten, wobei einige Einträge jedoch dieselbe Nummer haben. Dadurch überschreibt mir Excel derzeit lediglich die Einträge und schreibt die jeweils nächsten Einträge mit derselben Nummer nicht in die nächste übereinstimmende Zeile. Vielleicht weiß jemand von Euch, was ich im Code noch anpassen muss, dass die Übernahme funktioniert.

Code:

Sub Beispiel()

   Dim LoL_1 As Long
   Dim LoL_2 As Long
   Dim r1 As Long
   Dim z1 As Long
   Dim x1 As Long
   Dim ws2 As Worksheet

   Set ws2 = Worksheets("Tabelle1")
   With Worksheets("Tabelle2")
       LoL_1 = .Cells(Rows.Count, "B").End(xlUp).Row
       LoL_2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
       z1 = 2
       For r1 = 2 To LoL_1
           For x1 = 1 To LoL_2
               If ws2.Range("A" & x1) = .Range("B" & r1) Then
                   .Range("C" & r1) = ws2.Range("B" & x1)
                   z1 = z1 + 1
               End If
           Next
       Next
   End With
End Sub

[Der Steuerfuzzi]

Hallo,

das geht mit Formeln auch:

Code:

=INDEX(Tabelle1!B:B;AGGREGAT(15;6;1/(B2=Tabelle1!$A$2:$A$14)*ZEILE(Tabelle1!$A$2:$A$14);ZÄHLENWENN($B$2:B2;B2)))

[Jockel]

Hallo, oder so..:

Code:

=INDEX(Tabelle1!B:B;AGGREGAT(15;6;ZEILE(Tabelle1!$A$2:$A$14)/(B2=Tabelle1!$A$2:$A$14);ZÄHLENWENN($B$2:B2;B2)))

[sunny01]

Hallo,

vielen Dank für Eure Formellösungen. Habe beim Ausprobieren nur entdeckt, dass es derzeit bei den Formeln eine Fehlermeldung gibt, wenn eine weitere Zahl (z.B. dreimal die "3") in Tabelle 2 steht obwohl nur zwei Einträge in Tabelle 1 vorhanden sind. Vielleicht könnt ihr das noch in die Formel integrieren, dass in diesem Fall ev. "0" ausgegeben wird.

[Jockel]

Hallo, das kannst du mit

 

Code:

=WENNFEHLER(deine_Formel();0)

 
abfangen...

[sunny01]

Hallo,

die Formellösung funktioniert sehr gut! Ich habe nur das Problem, dass die Ausgangstabelle per Makro immer wieder neu angelegt wird und sich dadurch leider die Formeln in der Zieltabelle ungewollt verändern nach der Ausführung des Makros. Deshalb wäre es gut, wenn jemand eventuell noch eine Lösung auf die Anpassung meines Makros hätte!?

[sunny01]

Hallo,

weiß jemand von Euch, wie in der beiliegenden Beispieldatei der Code (siehe oben) angepaßt werden müsste, dass bei zwei oder mehr übereinstimmenden gleichen Einträgen der Wert zuletzt nicht überschrieben wird sondern der neue Wert in die nächste übereinstimmende Zeile geschrieben wird!?

[Der Steuerfuzzi]

Versuch das mal:

Code:

Sub Beispiel2()
Dim Daten As Variant
Dim Abgleich As Variant
Dim i As Long
Dim k As Variant

Daten = Tabelle1.Range(Tabelle1.Cells(2, 1), Tabelle1.Cells(Rows.Count, 2).End(xlUp))
Abgleich = Tabelle2.Range(Tabelle2.Cells(2, 2), Tabelle2.Cells(Rows.Count, 2).End(xlUp).Offset(, 1))
For i = 1 To UBound(Abgleich)
    k = Application.Match(Abgleich(i, 1), Application.Index(Daten, 0, 1), 0)
    If VarType(k) <> 10 Then
        Abgleich(i, 2) = Daten(k, 2)
        Daten(k, 1) = ""
    Else
        Abgleich(i, 2) = ""
    End If
Next
Tabelle2.Cells(2, 3).Resize(UBound(Abgleich)).Value = Application.Index(Abgleich, 0, 2)
End Sub

[snb]

- Benütze immer Spalte A
- Benütze immer Zeile 1
- Benütze immer Zelle A1
- Lade keine Dateien mit ausgeblendeten Spalten/Zeilen hoch

Code:

Sub M_snb()
   sn = Tabelle1.Cells(1).CurrentRegion
   sp = Tabelle2.Cells(1).CurrentRegion
   
   For j = 2 To UBound(sp)
     For jj = 2 To UBound(sn)
       If sn(jj, 1) = sp(j, 1) Then
         sp(j, 2) = sn(jj, 2)
         sn(jj, 1) = ""
         Exit For
       End If
    Next
  Next
 
  Tabelle2.Cells(1).CurrentRegion= sp
End Sub

[shift-del]

Glückwunsch, snb.
Das war deine Nummer 1000, wie ich gerade feststelle.
:18: