in vorhandene excel datei drei zeilen mit gleichem inhalt einfügen

Question

hallo, habe einen terminarbeit bis 18:00 bekommen und kann sie nicht lösen! habe noch nie mit makros gearbeitet.
herzlichen dank!

problem:
datei mit vielen datensätzen

123.35467.234
123.35498.635
usw....
es soll eine liste werden:

123.35467.234
a
b
c
123.35498.635
...

jeweis in spalte b die drei buchstaben

[*][sup]
*Threadedit* 29.06.2009, 19:13:06
Admininfo: Führ bitte Threads nicht fort indem du Weitere eröffnest, und vermeide Mehrfachanfragen. Die Datenbank und User werden es dir danken. Siehe FAQ 2, #3.[/sup]

Answer 1

hi all

wie gewünscht ^^

gruss nighty

Option Explicit
Sub Einfuegen()
Dim Zeilen As Long
Dim Feld() As Variant
Feld = Array("A", "B", "C")
For Zeilen = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
Rows(Zeilen & ":" & Zeilen + 2).Insert Shift:=xlDown
Range("A" & Zeilen & ":A" & Zeilen + 2) = Application.Transpose(Feld())
Next Zeilen
End Sub

Answer 2

hallo,
erst mal supper dank für die schnell antwort.
da ist noch ein kleines problem, die buchstaben müssen in spalte b! was muss ich abändern?

nachdem ich die datei in drei kleine häppchen aufgeteilt habe funktioniert es schon besser.


die dinger sind ja der hitt, ich unwissende werde mich in das thema reinkniehen, das ist ja arbeitserleichterung pur!

über eine erneute hilfe wäre ich sehr sehr dankbar.
gruß nanook

Answer 3

hallo,
war so unter stress, habe den wald vor lauter bäumen nicht gesehen!!!!!!!!!!!!!
geschafft!
herzlichen dank!
gruß nanok

Answer 4

hi nanok ^^

dann hier eine variante die um einiges schneller waere :-)

gruss nighty

Option Explicit
Sub trennen()
Dim Index As Long
Dim TbZeile As Long
Dim Zaehler As Long
TbZeile = Cells(Rows.Count, 1).End(xlUp).Row
ReDim TbSpaA(TbZeile, 1) As Variant
ReDim TbSpaA1(TbZeile * 4, 1) As Variant
ReDim TbSpaB1(TbZeile * 4, 1) As Variant
TbSpaA() = Range(Cells(1, 1), Cells(TbZeile, 1))
TbSpaA1() = Range(Cells(1, 1), Cells(TbZeile * 4, 1))
TbSpaB1() = Range(Cells(1, 2), Cells(TbZeile * 4, 2))
TbSpaB1() = Range(Cells(1, 2), Cells(TbZeile * 4, 2))
TbSpaA1(1, 1) = TbSpaA(1, 1)
Index = 1
For Zaehler = 2 To UBound(TbSpaA1) - 3 Step 4
Index = Index + 1
TbSpaA1(Zaehler, 1) = TbSpaA(Index, 1)
TbSpaA1(Zaehler + 1, 1) = ""
TbSpaA1(Zaehler + 2, 1) = ""
TbSpaA1(Zaehler + 3, 1) = ""
TbSpaB1(Zaehler + 1, 1) = "A"
TbSpaB1(Zaehler + 2, 1) = "B"
TbSpaB1(Zaehler + 3, 1) = "C"
Next Zaehler
Range(Cells(1, 1), Cells(TbZeile * 4, 1)) = TbSpaA1()
Range(Cells(1, 2), Cells(TbZeile * 4, 2)) = TbSpaB1()
End Sub

Answer 5

hi all ^^

nagut ,wie immer korrigiert :-))

gruss nighty

Option Explicit
Sub trennen()
Dim Index As Long
Dim TbZeile As Long
Dim Zaehler As Long
TbZeile = Cells(Rows.Count, 1).End(xlUp).Row
ReDim TbSpaA(TbZeile, 1) As Variant
ReDim TbSpaA1(TbZeile * 4, 1) As Variant
ReDim TbSpaB1(TbZeile * 4, 1) As Variant
TbSpaA() = Range(Cells(1, 1), Cells(TbZeile, 1))
TbSpaA1() = Range(Cells(1, 1), Cells(TbZeile * 4, 1))
TbSpaB1() = Range(Cells(1, 2), Cells(TbZeile * 4, 2))
TbSpaA1(1, 1) = TbSpaA(1, 1)
Index = 1
For Zaehler = 2 To UBound(TbSpaA1) - 3 Step 4
Index = Index + 1
TbSpaA1(Zaehler, 1) = TbSpaA(Index, 1)
TbSpaA1(Zaehler + 1, 1) = ""
TbSpaA1(Zaehler + 2, 1) = ""
TbSpaA1(Zaehler + 3, 1) = ""
TbSpaB1(Zaehler + 1, 1) = "A"
TbSpaB1(Zaehler + 2, 1) = "B"
TbSpaB1(Zaehler + 3, 1) = "C"
Next Zaehler
Range(Cells(1, 1), Cells(TbZeile * 4, 1)) = TbSpaA1()
Range(Cells(1, 2), Cells(TbZeile * 4, 2)) = TbSpaB1()
End Sub

Answer 6

hi all ^^

zeitmessung bei 10 000 zeilen

gruss nighty

makro antwort 1 ohne ereignisabschaltung / 59 sek
makro antwort 1 mit ereignisabschaltung / 51 s

makro antwort 5 mit einem array / unter 1 sekunde

gruss nighty

Answer 7

hallo,
danke!!!!!!!!!!!! gestern war ich echt beschränkt, zu viel stress.
mit der 2. makro geht es echt fix, habe es gleich abegändert auf eine andere liste und es ist ein augenzwingern bis er die 17000 datensätze geändert hatte. komme gleich mit einem anderen thema.