zahl auslesen und zeile kopieren
21.11.2016 12:12:03
Michael
ich greife das thema nochmals auf. sorry, aber ich bin anscheinend zu blöd, das thema vom 12.11. nochmals aufzurufen und darauf zu antworten.
hier nochmals die problemstellung:
ich habe eine tabelle mit sendungsinformationen:
name, firma, adresse, plz, ort,..., anzahl pakete (spalte AL)
mein problem ist, dass ich pro paket eine zeile in eine csv schreiben muss. der vba-code für den export steht und funktioniert.
ich bräuchte nun einen zusatz, welcher beim export die anzahl der pakete liest und dementsprechend die zeile kopiert.
d.h.
paketanzahl 1 = nix tun
paketanzahl 2 = zeile 1 mal kopieren
paketanzahl 3 = zeile 2 mal kopieren
usw.
den code, welchen ich werden ist der folgende:
--------------
Sub Schaltfläche2_Klicken()
Dim Bereich As Object, Zeile As Object, Zelle As Object
Dim strTemp As String
Dim strDateiname As String
Dim strTrennzeichen As String
Dim strMappenpfad As String
Dim Startspalte As Integer
Dim Endespalte As Integer
Dim Startzeile As Long
Dim Endezeile As Long
Startspalte = Worksheets("export").UsedRange.Column
Endespalte = Worksheets("export").UsedRange.Column + Worksheets("export").UsedRange.Columns. _
Count - 26
Startzeile = Worksheets("export").UsedRange.Row
Endezeile = Worksheets("export").UsedRange.Row + Worksheets("export").UsedRange.Rows.Count - 1
Set Bereich = Worksheets("export").Range(Cells(Startzeile, Startspalte), Cells(Endezeile, _
Endespalte))
strMappenpfad = ActiveWorkbook.FullName
strMappenpfad = Replace(strMappenpfad, ".xls", ".csv")
strDateiname = "C:\Temp\export.csv"
If strDateiname = "" Then Exit Sub
strTrennzeichen = ";"
If strTrennzeichen = "" Then Exit Sub
'Set Bereich = ActiveSheet.UsedRange
Open strDateiname For Output As #1
For Each Zeile In Bereich.Rows
If Not Zeile.Hidden Then
For Each Zelle In Zeile.Cells
strTemp = strTemp & """" & CStr(Zelle.Text) & """" & strTrennzeichen
Next
If Right(strTemp, 1) = strTrennzeichen Then
strTemp = Left(strTemp, Len(strTemp) - 1)
End If
Print #1, strTemp
strTemp = ""
End If
Next
Close #1
Set Bereich = Nothing
End Sub
-------------------
danke für eure hilfe!!!
mike