Ziffer/Zeichen Kombinationen erstellen

Hi Leute
Ich knobble nun schon seid längerem an folgendem Problem rum und hoffe ich finde hier jemand der mir weiterhelfen kann.
Ich bin dabei die Lagerplätze in unserem Lager neu zu beschriften. Um ein erneutes Ghetto zu verhindern setzte ich die Lagerplatzbeschriftung aus Zeichen und Ziffern zusammen. Nun möchte ich die entsprchenden Werte aus fünf Spalten auslesen und alle möglichen Kombinationen in eine neue Spalte schreiben
Beispiel
Spalte A(Lagerort):A(A-D)
Spalte B(Regalreihe):A(A-Z)
Spalte C(Feld):01(01-30)
Spalte D(Fach):A(A-Z)
Spalte E(Behälter):01(01-12)
Aus diesen Spalten sollte sich dann in einer neuen Spalte folgende Kombination ergeben AA01A01
Das Ziel ist schlussendlich die Daten in die Lagerplatzdatenbank der ERP exportieren zu können.
Hat jemand von Euch eine Idee wie ich dies Lösen könnte?
Danke schon im Voraus für Eure feedbacks
Nic

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub CreateLager() Dim A As Integer, B As Integer, C As Integer, D As Integer, E As Integer Dim iCol As Long, iRow As Long, vntValues() Application.ScreenUpdating = False ReDim vntValues(1 To Rows.Count, 1 To 1) iRow = 1 iCol = 1 For A = 65 To 68 For B = 65 To 90 For C = 1 To 30 For D = 65 To 90 For E = 1 To 12 vntValues(iRow, 1) = _ Chr(A) & Chr(B) & Format(C, "00") & Chr(D) & Format(E, "00") If iRow = Rows.Count Then Cells(1, iCol).Resize(Rows.Count, 1) = vntValues ReDim vntValues(1 To Rows.Count, 1 To 1) iRow = 0 iCol = iCol + 1 End If iRow = iRow + 1 Next E Next D Next C Next B Next A Cells(1, iCol).Resize(iRow, 1) = vntValues Application.ScreenUpdating = True End Sub

Hi Nic,
Frage noch offen, da 1004 kommt beim Autofill der Spalte A, also hier:
Range("A1:A" & E * D * C * B * A).AutoFill Destination:=Range("A1:A" & G), Type:=xlFillCopy
deshalb On Error Resume Next im Code.
Im Code anpassen mußt du hier:
A = 4 'A-D
B = 4 'A-D
C = 10 '01-10
D = 4 'A-D
E = 10 '01-10


Option Explicit
Sub Zahl()
Dim Spa As Long, Zei As Long, N As Long, A, B, C, D, E, G, W
On Error Resume Next
A = 4       'A-D
B = 4       'A-D
C = 10      '01-10
D = 4       'A-D
E = 10      '01-10
G = A * B * C * D * E
Columns(3).NumberFormat = "@"
Columns(5).NumberFormat = "@"
For N = 1 To E
Zei = Zei + 1
Cells(Zei, 5) = Format(N, "00")
Next N
Range("E1:E" & E).AutoFill Destination:=Range("E1:E" & G), Type:=xlFillCopy
Zei = 0
For W = 1 To D
For N = 1 To E
Zei = Zei + 1
Cells(Zei, 4) = Chr(64 + W)
Next N
Next W
Range("D1:D" & E * D).AutoFill Destination:=Range("d1:d" & G), Type:=xlFillCopy
Zei = 0
For W = 1 To C
For N = 1 To E * D
Zei = Zei + 1
Cells(Zei, 3).Value = Format(W, "00")
Next N
Next W
Range("c1:c" & E * D * C).AutoFill Destination:=Range("c1:c" & G), Type:=xlFillCopy
Zei = 0
For W = 1 To B
For N = 1 To E * D * C
Zei = Zei + 1
Cells(Zei, 2) = Chr(64 + W)
Next N
Next W
Range("b1:b" & E * D * C * B).AutoFill Destination:=Range("b1:b" & G), Type:=xlFillCopy
Zei = 0
For W = 1 To A
For N = 1 To E * D * C * B
Zei = Zei + 1
Cells(Zei, 1) = Chr(64 + W)
Next N
Next W
Range("A1:A" & E * D * C * B * A).AutoFill Destination:=Range("A1:A" & G), Type:=xlFillCopy
Range("F1:F" & G).Formula = "=A1&B1&C1&D1&E1"
End Sub

Gruß
Reinhard

Beliebteste Forumthreads (12 Monate)

Ziffer/Zeichen Kombinationen erstellen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Ziffer/Zeichen Kombinationen erstellen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread