Anzeige
Archiv - Navigation
1352to1356
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

VBA - Dreifache Schleife

VBA - Dreifache Schleife
31.03.2014 12:58:22
Markus
Hallo zusammen,
ich bin wieder an einem Punkt angekommen, wo man den Baum vor lauter Bäumen nicht mehr sieht, glaube ich zumindest. Vielleicht sieht ja jemand von euch den Baum bzw. das Brett vor meinen Kopf.
Folgende Ausgangslage.
Ich habe eine Tabelle in der immer wieder neue Daten eingetragen werden. Ich möchte nun das diese Daten in eine zweite eingetragen werden, dabei aber gewisse Kriterien berücksichtigt werden.
Es gibt einen Artikel /Eintrag, der mit 4 Kriterien beschrieben wird. Dieser Artikel/Eintrag kann nun x unterschiedliche Merkmale aufweisen, die alle aufgelistet sind.
Ich möchte nun, dass im zweiten Tabelleblatt jedes Kriterium in eine Spalte eingetragen wird. Hierbei soll geprüft werden, ob das Kriterium bereist vorhanden ist, wenn nicht, neu anlegen werden. Jedes Kriterium hat seine eigene Spalte. Hierbei wird die senkrechte Anorndung der Kriterien von Tabelle 1 in eine waagerechte Anordnung in Tabelle 2 überführt. Sind die Kriterien überprüft und ggf. angelegt, soll nun unter jedem Kriteriem der vollständig beschriebene Artikel/ Eintrag abgelegt werden, dabei immer in die nächste freie Teile des Kriteriums.
Anbei eine Datei, die das verdeutlicht. Ich habe es schon hinbekommen, dass wenn das Kriterium nicht vorhanden ist, es angelegt wird, doch leider wird beim Schreiben des nächsten Kriterium in die nächste Spalte, das erste immer wieder überschrieben. Es muss also eine Schleife sein, die in Tabelle2 sowohl spalten technisch läuft, als auch zeilenmäßig in Tabelle 1 die Kriterien abfragt und in Tabelle 2 überträgt.
In meinem Beispiel wird in Tabelle 3 gezeigt, wie das nachher aussehen soll. In Tabelle 2 wird momentan das eingetagen was der Code so schon ausführt.
Vielleicht kann da mal jemand schauen.
https://www.herber.de/bbs/user/89930.xlsm
Sub test()
Produkt = Worksheets("Tabelle1").Cells(8, 3).Value & " " & Worksheets("Tabelle1").Cells(9, 3).  _
_
Value & " " & Worksheets("Tabelle1").Cells(10, 3).Value & " " & Worksheets("Tabelle1").Cells(11, _
3).Value
letztespalte = Sheets("Tabelle2").Cells(1, 256).End(xlToLeft).Column ' Ermittelt die letzte  _
beschriebene Spalte
'MsgBox letztespalte
X = 1   'Startwert ab welcher der Spalte
Z = 18  ' Startwert ab welcher der Zeile
With Sheets("Tabelle2")
Dim Y As Integer
Dim leer As Integer
Do
If .Cells(1, X)  "" Then
leer = False
Else
leer = True
End If
If Worksheets("Tabelle1").Cells(Z, 3).Value = Worksheets("Tabelle2").Cells(1, X).Value Then
LetzteZeile = Worksheets("Tabelle2").Cells(Rows.Count, X).End(xlUp).Row + 1
Worksheets("Tabelle2").Cells(LetzteZeile, X).Value = Produkt
Exit Sub
Else
Worksheets("Tabelle2").Cells(1, X).Value = Worksheets("Tabelle1").Cells(Z, 3).Value
LetzteZeile = Worksheets("Tabelle1").Cells(Rows.Count, X).End(xlUp).Row + 1
Worksheets("Tabelle2").Cells(LetzteZeile, X).Value = Produkt
End If
X = X + 1
Loop Until leer = True
End With
End Sub

Gruß Markus

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA - Dreifache Schleife
31.03.2014 17:02:38
fcs
Hallo Markus,
sollte etwa wie folgt funktionieren.
Gruß
Franz
Sub test()
Dim Y As Long, X As Long, Z As Long, letztespalte As Long
Dim Produkt As String, varFehler As Variant
Dim Zelle As Range
With Worksheets("Tabelle1")
Produkt = .Cells(8, 3).Value & " " & .Cells(9, 3).Value & " " _
& .Cells(10, 3).Value & " " & .Cells(11, 3).Value
For Z = 18 To .Cells(.Rows.Count, 3).End(xlUp).Row ' Startwert ab welcher der Zeile
varFehler = .Cells(Z, 3).Value
With Sheets("Tabelle2")
' Ermittelt die letzte beschriebene Spalte
letztespalte = .Cells(1, .Columns.Count).End(xlToLeft).Column
'MsgBox letztespalte
'Fehler in Zeile 1 der Ergebnistabelle suchen
Set Zelle = .Rows(1).Find(What:=varFehler, LookIn:=xlValues, lookat:=xlWhole)
If Zelle Is Nothing Then
If IsEmpty(.Cells(1, 1)) Then
X = 1
Else
X = letztespalte + 1
End If
.Cells(1, X).Value = varFehler
Else
X = Zelle.Column
End If
'letzte Zeile mit Daten in Spalte finden
Y = .Cells(.Rows.Count, X).End(xlUp).Row + 1
.Cells(Y, X).Value = Produkt
End With
Next
End With
End Sub

Anzeige
AW: VBA - Dreifache Schleife
31.03.2014 20:09:03
Markus
Hallo Franz,
macht genau was es soll. Vielen, vielen Dank.
Ich bin echt beeindruckt wie ihr das immer macht.
Muss den Code jetzt ersteinmal zerlegen , um das zu verstehen.
Danke.
Gruß Markus

AW: VBA - Dreifache Schleife
31.03.2014 20:10:09
Markus
Hallo Franz,
macht genau was es soll. Vielen, vielen Dank.
Ich bin echt beeindruckt wie ihr das immer macht.
Muss den Code jetzt ersteinmal zerlegen , um das zu verstehen.
Danke.
Gruß Markus

309 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige