Supportnet Computer
Planet of Tech

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...

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


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

Antwort 3 von gast123

hi all :-)

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 :-)))

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

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

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