Supportnet / Forum / Tabellenkalkulation
Zellen kopieren und tiefer einfügen mit Makro
Frage
Ich habe eine Excel Tabelle in der immer zwischen den ausgefüllten Zeilen (Spalte A - N) eine Zeile ist in der die Spalten F - I leer sind (die anderen Spalten sind gefüllt. Gesamtlänge sind 750 Zeilen. Nun soll Excel die Werte der Spalten F,G und I aus den beschriebenen Zeilen in die Spalten F, G und I der jeweils darunter befindlichen leeren Zellen F, G und I einsetzen und dann zur nächsten Zeile gehen und wiederrum die Spalten F - I kopieren und darunter in F - I einsetzen bis zum Ende der Tabelle. Die Spalten F - I haben in jeder Zeile andere Werte.
Kann mir dazu jemand einen Lösungsvorschlag machen? Ich bin mit meinen doch sehr begrenzten VBA Kenntnissen am Ende.
VIELEN DANK IM VORAUS!!!
Anja
Antwort 1 von morpheus__85
Hallo Anja
ich hoffe ich hab dein Problem richtig verstanden.
Du hast also unter einer beschriebenen Celle z.b F1 immer dann eine leere Zelle drunter z.B. F2
Wenn F1 leer ist ist G1 und I1 auch leer stimmt das so?
Ich hab mal versucht dir zu helfen probier es mal damit...
Schau mal ob das das ist was du brauchst und wenn du noch hilfe brauchst schreib einfach nochmal.
gruß
morpheus
ich hoffe ich hab dein Problem richtig verstanden.
Du hast also unter einer beschriebenen Celle z.b F1 immer dann eine leere Zelle drunter z.B. F2
Wenn F1 leer ist ist G1 und I1 auch leer stimmt das so?
Ich hab mal versucht dir zu helfen probier es mal damit...
Zitat:
Public Sub Ausfüllen()
Dim i, x
i = 1
Do
i = i + 1
Loop Until Cells(i, 6).Value = "" And Cells(i + 1, 6).Value = ""
x = 0
Do
x = x + 1
If Cells(x, 6).Value = "" And Cells(x, 7).Value = "" And Cells(x, 9).Value = "" Then
Cells(x, 6).Value = Cells(x - 1, 6).Value
Cells(x, 7).Value = Cells(x - 1, 7).Value
Cells(x, 9).Value = Cells(x - 1, 9).Value
Else
End If
Loop Until x = i
End Sub
Public Sub Ausfüllen()
Dim i, x
i = 1
Do
i = i + 1
Loop Until Cells(i, 6).Value = "" And Cells(i + 1, 6).Value = ""
x = 0
Do
x = x + 1
If Cells(x, 6).Value = "" And Cells(x, 7).Value = "" And Cells(x, 9).Value = "" Then
Cells(x, 6).Value = Cells(x - 1, 6).Value
Cells(x, 7).Value = Cells(x - 1, 7).Value
Cells(x, 9).Value = Cells(x - 1, 9).Value
Else
End If
Loop Until x = i
End Sub
Schau mal ob das das ist was du brauchst und wenn du noch hilfe brauchst schreib einfach nochmal.
gruß
morpheus
Antwort 2 von gast123
hi all :-)
ein ansatz
do loop schleife mit raussprung bei zeilenende
innerhalb der do schleife koennte die findfunction eine leere zelle suchen in einem begrenzten bereich um darauf zu reagieren mit copy
bei mehrmaligen gebrauchs und oder grosse datenmengen,entsprechende events ausschalten bei ende wieder anschalten
gruss gast123
ein ansatz
do loop schleife mit raussprung bei zeilenende
innerhalb der do schleife koennte die findfunction eine leere zelle suchen in einem begrenzten bereich um darauf zu reagieren mit copy
bei mehrmaligen gebrauchs und oder grosse datenmengen,entsprechende events ausschalten bei ende wieder anschalten
gruss gast123
Antwort 3 von gast123
hi all :-)
hat sich mal wieder ueberschnitten :-))
gruss gast123
hat sich mal wieder ueberschnitten :-))
gruss gast123
Antwort 4 von gast123
hi morpheus :-)
schon mal nicht schlecht dein makro :-)
folgende verbesserungsvorschlaege mit denen du dich beschaeftigen solltest
statt einen zaehler in der wiederholungsschleife einzusetzen und dadurch immer das max an durchlaeufe zu produzieren wuerde sich hier die findfunction anbieten
beispiel
500zeilen mit zaehler ergibt trefferunanhaengig 500 durchlaeufe
500zeilen mit der findfunction abgetastet ergibt soviel durchlaeufe wie treffer sind
also enorm schneller waere
noch eine variante
lege einen bereich in ein array und setze im vergleich nun das array ein, waere auch schoen schnell
noch eine variante
ein dictionaryobjekt erstellen,das waere dann glaub ich die schnellste moeglichkeit
viel spass am tuefteln :-))
gruss gast123
ach ja deklariere deine variablen korrekt :-)))
schon mal nicht schlecht dein makro :-)
folgende verbesserungsvorschlaege mit denen du dich beschaeftigen solltest
statt einen zaehler in der wiederholungsschleife einzusetzen und dadurch immer das max an durchlaeufe zu produzieren wuerde sich hier die findfunction anbieten
beispiel
500zeilen mit zaehler ergibt trefferunanhaengig 500 durchlaeufe
500zeilen mit der findfunction abgetastet ergibt soviel durchlaeufe wie treffer sind
also enorm schneller waere
noch eine variante
lege einen bereich in ein array und setze im vergleich nun das array ein, waere auch schoen schnell
noch eine variante
ein dictionaryobjekt erstellen,das waere dann glaub ich die schnellste moeglichkeit
viel spass am tuefteln :-))
gruss gast123
ach ja deklariere deine variablen korrekt :-)))
Antwort 5 von morpheus__85
Hallo gast 123
hört sich interessant an deine vorschläge muss ich mir mal anschaun.
Ich bin noch nicht sooo tief in der Materie drin behfelfe mir mit dem was ich kann und das hilft meistens auch ;-)
Danke für deine Tips
gruß
morpheus
hört sich interessant an deine vorschläge muss ich mir mal anschaun.
Ich bin noch nicht sooo tief in der Materie drin behfelfe mir mit dem was ich kann und das hilft meistens auch ;-)
Danke für deine Tips
gruß
morpheus
Antwort 6 von gast123
hi morpheus :-)
moecht dich ja net im regen stehen lassen :-))
ein beispiel der findfunction
gruss gast123
gesucht wird zur zeit die 6
z.b.
wie schon oben beschrieben
angenommen 500 zeilen und zwei fundstellen,so waeren es nun 2 durchlaeufe,bei 10000 zeilen und zwei fundstellen auch zwei durchlaeufe
moecht dich ja net im regen stehen lassen :-))
ein beispiel der findfunction
gruss gast123
gesucht wird zur zeit die 6
z.b.
wie schon oben beschrieben
angenommen 500 zeilen und zwei fundstellen,so waeren es nun 2 durchlaeufe,bei 10000 zeilen und zwei fundstellen auch zwei durchlaeufe
Option Explicit
Sub Suchen()
Dim suche As Range
Dim zaehler As Long
zaehler = 1
Do
Set suche = Workbooks(1).Worksheets(1).Range("A" & zaehler & ":A" & Workbooks(1).Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row).Find("6")
If Not suche Is Nothing Then
Rem etwas gefunden
zaehler = suche.Row + 1
Else
Rem nicht gefunden
Exit Do
End If
Loop
End Sub
Antwort 7 von gast123
hi morpheus :-)
ich mal wieder :-)
nun noch ein beispiel einer suche in einem array
gesucht wird die 6
gruss gast123
cell wie array koordinaten laufen parallel daher leichter zugriff
zu beachten waere das bei der zuweisung des array KEINE angaben zu workbook wie worksheet sein duerfen,aus diesem grunde ist eine selection erlaubt
Option Explicit
Sub Suchen()
Dim zaehler0 As Long
Dim zaehler1 As Long
Dim zeile As Long
Dim spalte As Integer
Worksheets(1).Select
zeile = Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
spalte = Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
ReDim bereich(zeile, spalte) As Variant
bereich() = Range(Cells(1, 1), Cells(zeile, spalte))
For zaehler0 = 2 To zeile
For zaehler1 = 1 To spalte
If bereich(zaehler0, zaehler1) = "6" Then
Rem etwas gefunden
Else
Rem nichts gefunden
End If
Next zaehler1
Next zaehler0
End Sub
ich mal wieder :-)
nun noch ein beispiel einer suche in einem array
gesucht wird die 6
gruss gast123
cell wie array koordinaten laufen parallel daher leichter zugriff
zu beachten waere das bei der zuweisung des array KEINE angaben zu workbook wie worksheet sein duerfen,aus diesem grunde ist eine selection erlaubt
Option Explicit
Sub Suchen()
Dim zaehler0 As Long
Dim zaehler1 As Long
Dim zeile As Long
Dim spalte As Integer
Worksheets(1).Select
zeile = Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
spalte = Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
ReDim bereich(zeile, spalte) As Variant
bereich() = Range(Cells(1, 1), Cells(zeile, spalte))
For zaehler0 = 2 To zeile
For zaehler1 = 1 To spalte
If bereich(zaehler0, zaehler1) = "6" Then
Rem etwas gefunden
Else
Rem nichts gefunden
End If
Next zaehler1
Next zaehler0
End Sub