Wie füge ich eine Variable Anzahl an Zeilen in Excel per VBA ein?
ich habe eine Tabelle
A B
1 Artikel Anzahl
2 aaa 2
3 bbb 4
ich möchte jetzt für jede Spalte ab Spalte 2 schauen welcher wert in Zeile B steht, dann die aktuelle Spalte kopieren
und so häufig einfügen wie es in B steht (minus 1)
Egebnis von meinem Beistpiel ist dann:
A B
1 Artikel Anzahl
2 aaa 2
3 aaa 2
4 bbb 4
5 bbb 4
6 bbb 4
7 bbb 4
1 Antwort
Hallo Unbekannt,
ohne VBA kannst du das am einfachsten mit der INDEX-Funktion in Kombination mit der VERGLEICH-Funktion lösen:
schreib in Zelle B2 deiner "langen" Liste:
=INDEX('Tabelle_mit_Stammdaten'!B:B;VERGLEICH(A2;'Tabelle_mit_Stammdaten'!A:A;0);1)
Zur Erklärung:
INDEX nimmt die Werte aus der zweiten Spalte der Stammdaten und wählt die Zeile aus, in der in der ersten Spalte der gesuchte Artikel steht. Die Suche selbst übernimmt dabei die VERGLEICH-Funktion.
Um den Programmieraufwand möglichst klein zu halten, solltest du die zwei Zellbereiche in intelligente Tabellen verwandeln. Dazu gehst du jeweils in eine Zelle der Zellebreiche und drückst STRG+t. Die eine Tabelle kannst du z.B. "tblStammDaten" nennen, die zweite "tblListe". (Das Feld findest du im Tabellenribbon links als Tabellennamen. Dazu muss eine Zelle der intelligenten Tabelle ausgewählt sein.)
Dadurch sparst du dir das Ermitteln von erster und letzer Zeile, sonder kannst eine einfache FOR EACH - NEXT - Schleife anwenden:
Option Explicit
Sub TabelleAuslesen()
Dim Anzahl
Dim rngListe As Range
Dim rngStammdaten As Range
For Each rngListe In _
Thisworkbook.Worksheets("Sheet1"). _
Range("tblListe[Artikel]")
' Die Referenzzelle aus den Stammmdaten finden
' (Achtung: Die Suche ergibt eine Fehlermeldung,
' falls der Wert in dem Referenzbereich nicht gefunden
' wird.)
rngStammdaten = _
WorksheetFunction.Match(rngListe.Value, _
ThisWorkbook.Worksheets("Sheet1"). _
Range("tblStammdaten[Artikel]"), 0)
' Wert aus der Nachbarzelle auslesen
Anzahl = rngStammdaten.Offset(0, 1).Value
' Wert in die Referenzzelle eintragen
rngListe.Offset(0, 1).Value = Anzahl
Next Rng
End Sub
Hoffe, es hilft dir :-)
LG, Matej