Übernahme von Exceldatenblöcken in Liste
22.08.2013 15:42:55
Exceldatenblöcken
ich habe mir ein Ziel gesetzt, welches ich Momentan nicht bewältigen kann. Die Idee dazu ist da, nur der Ansatz fehlt.
Ich möchte aus einem Formular exportierte Datenblöcke in einer Liste sammeln.
In diesem Formular sind Ladelisten gesammelt, die Positionen beinhalten,
bis die nächste Ladeliste mit den nächsten Positionen kommt usw.
Man kann annehmen, dass jede Ladeliste mit "Versandtag:" beginnt.
Da aber manchmal zwei oder mehr Ladungsträger für einen Artikel benötigt werden, macht sich das alles irgendwie kompliziert.
Derzeit bin ich soweit:
Sub Übersicht_füllen()
B = 4
For L = 1 To 3000
N(L, 3) = Worksheets("Export einfügen").Cells(L, 3).Value
If N(L, 3) = "Versandtag:" Then
N(L + 2, 3) = Worksheets("Export einfügen").Cells(L + 2, 3).Value 'Ladelistennummer'
N(L + 4, 5) = Worksheets("Export einfügen").Cells(L + 4, 5).Value 'LT-Nummer'
N(L, 1) = Worksheets("Export einfügen").Cells(L, 1).Value 'Spedition'
N(L + 3, 1) = Worksheets("Export einfügen").Cells(L + 3, 1).Value 'Abladestelle'
N(L + 4, 1) = Worksheets("Export einfügen").Cells(L + 4, 1).Value 'Stückzahl'
N(L + 5, 1) = Worksheets("Export einfügen").Cells(L + 5, 1).Value 'zweite Stückzahl?'
N(L + 5, 5) = Worksheets("Export einfügen").Cells(L + 5, 5).Value 'zweite LT-Nummer'
If N(L + 5, 1) = "" Then
Worksheets("Übersicht").Cells(B, 1).Formula = N(L + 3, 1)
Worksheets("Übersicht").Cells(B, 2).Formula = N(L, 1)
Worksheets("Übersicht").Cells(B, 3).Formula = N(L + 2, 3)
Worksheets("Übersicht").Cells(B, 4).Formula = Date
Worksheets("Übersicht").Cells(B, 5).Formula = N(L + 4, 5)
Worksheets("Übersicht").Cells(B, 6).Formula = N(L + 4, 1)
B = B + 1
Else
Worksheets("Übersicht").Cells(B, 1).Formula = N(L + 3, 1)
Worksheets("Übersicht").Cells(B, 2).Formula = N(L, 1)
Worksheets("Übersicht").Cells(B, 3).Formula = N(L + 2, 3)
Worksheets("Übersicht").Cells(B, 4).Formula = Date
Worksheets("Übersicht").Cells(B, 5).Formula = N(L + 4, 5)
Worksheets("Übersicht").Cells(B, 6).Formula = N(L + 4, 1)
Worksheets("Übersicht").Cells(B, 5).Formula = N(L + 5, 5)
Worksheets("Übersicht").Cells(B, 6).Formula = N(L + 5, 1)
B = B + 1
End If
End If
Next L
End Sub
Anmerkungen und Kritiken zum bisherigen Code sind gern erwünscht.
Datei:
https://www.herber.de/bbs/user/86985.xlsm
Anzeige