Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon nanook vom 29.06.2021, 16:30 Options

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

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

^{*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.}

Antwort schreiben

Antwort 1 von nighty vom 29.06.2021, 17:02 OptionsLösung

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

Antwort 2 von nanook vom 29.06.2021, 17:56 Options

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

Antwort 3 von nanook vom 29.06.2021, 19:58 Options

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

Antwort 4 von nighty vom 29.06.2021, 22:54 Options

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

Antwort 5 von nighty vom 29.06.2021, 22:59 Options

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

Antwort 6 von nighty vom 30.06.2021, 10:20 Options

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

Antwort 7 von nanook vom 30.06.2021, 10:37 Options

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.

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..

Neue Einträge

Tipp einschicken

News einschicken