Anpassung eines VB Scripts
15.10.2012 21:42:09
AcJoker
ein freundlicher User dieses Forums war so nett und hat mir folgenden Script geschrieben.
Sub newList()
Dim vntIn As Variant, vntOut() As Variant
Dim lngIndex As Long, LngC As Long, lngN As Long
With ActiveSheet
vntIn = .Range("A1:C" & .Cells(.Rows.Count, 1).End(xlUp).Row)
LngC = Application.Sum(.Columns(2))
Redim vntOut(1 To LngC, 1 To 2)
LngC = 1
For lngIndex = 1 To UBound(vntIn, 1)
If vntIn(lngIndex, 1) "" And IsNumeric(vntIn(lngIndex, 2)) Then
For lngN = 1 To vntIn(lngIndex, 2)
vntOut(LngC, 1) = vntIn(lngIndex, 1) & "-" & lngN
vntOut(LngC, 2) = vntIn(lngIndex, 3)
LngC = LngC + 1
Next
End If
Next
.Range("E1").Resize(UBound(vntOut, 1), 2) = vntOut
End With
End Sub
123 3 789
235 5 956
745 1 668
eine solche Tabelle
123-1 689
123-2 689
123-3 689
235-1 956
235-2 956
235-3 956
235-4 956
235-5 956
745-1 668
Spalte 1 ist eine fixe Zahl, Spalte 2 die Häufigkeit und Spalte 3 wieder eine fixe Zahl.
Nun würde ich das ganze gerne um eine Spalter erweitern. Diese Spalte enthält wiederrum eine fixe Zahl und soll bei der Ausgabe einfach nur der Häufigkeit nach in eine 3 Spalte geschrieben wiederen, genauso wie es jetzt schon mit Spalte 3 passiert.
Von VB habe ich leider recht wenig Ahnung.
Ich habe es nun mal so versucht aber es tut sich leider nichts.
Sub newList()
Dim vntIn As Variant, vntOut() As Variant
Dim lngIndex As Long, LngC As Long, lngN As Long
With ActiveSheet
vntIn = .Range("A1:D" & .Cells(.Rows.Count, 1).End(xlUp).Row)
Hier habe ich die Tabelle auf die spalte D ausgeweitet
LngC = Application.Sum(.Columns(2))
Redim vntOut(1 To LngC, 1 To 3)
Ich gehe davon aus das 1 To 2 bzw 3 den Ausgabebereich angebiet, in diesem Fall benötige ich _
anstatt 2 Spalten nun 3 Spalten.
LngC = 1
For lngIndex = 1 To UBound(vntIn, 1)
If vntIn(lngIndex, 1) "" And IsNumeric(vntIn(lngIndex, 2)) Then
For lngN = 1 To vntIn(lngIndex, 2)
vntOut(LngC, 1) = vntIn(lngIndex, 1) & "-" & lngN
vntOut(LngC, 2) = vntIn(lngIndex, 3)
vntOut(LngC, 3) = vntIn(lngIndex, 4)
Diese Zeile habe ich einfach kopiert. Steht LngC, X für die Spalte im Ausgabebereich? und Ind _
lng,Index, Y für die Spalte aus der kopiert wird?
LngC = LngC + 1
Next
End If
Next
.Range("E1").Resize(UBound(vntOut, 1), 2) = vntOut
End With
End Sub
Ich muss zugeben das ich den genauen ablauf bzw. die Aussage der Befehle leider nicht kenne.
Gruß
Joker