Makro in Excel programmieren - Zeilen x-mal kopieren

1 Antwort

Oubyi, UserMod Light
Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer
Microsoft Excel
14.10.2014, 23:55

Ich habe da mal auf die Schnelle was "zusammengestrickt", was zumindest bei meinem Versuch funktioniert hat.
Ist aber ohne Fehlerroutine etc.
Schau mal ob Du damit was anfangen kannst:

Sub Vermehren()
Dim Zelle As Range
Dim i1 As Integer
Dim i2 As Integer

For Each Zelle In Sheets("Tabelle1").Range("B1:B100")
    If Not IsEmpty(Zelle) Then
        For i1 = 1 To Zelle.Offset(0, -1)
               i2 = i2 + 1
               Sheets("Tabelle2").Cells(i2, 1).Value = Zelle.Value
        Next i1
    End If
Next Zelle
End Sub
Woher ich das weiß:Berufserfahrung – IT-Administrator (i.R.)
Iamiam  15.10.2014, 01:39

DH!
auf die Schnelle krieg ich sowas nicht hin, aber dank Deiner Vorlage wars schnell modifiziert:
und samt Formaten kriegst du es rüber, wenn Du anstatt
Sheets("Tabelle2").Cells(i2, 1).Value = Zelle.Value
folgende Zeile einfügst:
Zelle.Copy Destination:=Sheets("Tabelle2").Cells(i2, 1)

(das Destination:= kann glaubbe ich entfallen, aber der Klarheit/Lesbarkeit halber füge ich das üblicherweise mit ein).

1
Oubyi, UserMod Light  15.10.2014, 11:33
@Iamiam

Stimmt.
Wenn das so gewünscht ist, dann muss ".copy" helfen. Das "Destination:=" lasse ich - der Faulheit wegen ㋛ - meist weg, aber Du hast natürlich Recht, so ist der Code besser zu lesen.

0
Turtle1988 
Fragesteller
 15.10.2014, 11:48

Super, dass funktioniert schon mal recht gut :)!!! Vielen Dank!

Was ich festgestellt habe ist, dass sich die Angaben im Tabellenblatt2 nicht automatisch ändern, wenn in Tabellenblatt1 die Anzahl in Spalte A geändert wird. Was ich meine ist, dass ich das Makro dann noch mal ausführen muss. Ist es möglich eine automatische Änderung in den Code mit einzubinden?

0
Oubyi, UserMod Light  15.10.2014, 11:58
@Turtle1988

Dazu musst Du daraus eine Ereignis-Code machen.
Mach mal einen Rechtsklick auf den Tabellenreiter in Tabelle1 (unten, da wo Tabelle1 steht) und gehe dann auf "Code anzeigen...".
In das große Fenster des VBA-Editors, der sich dann öffnet kopierst Du folgenden, erweiterten Code: 

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
    Dim Zelle As Range
    Dim i1 As Integer
    Dim i2 As Integer
    
    For Each Zelle In Sheets("Tabelle1").Range("B1:B100")
        If Not IsEmpty(Zelle) Then
            For i1 = 1 To Zelle.Offset(0, -1)
               i2 = i2 + 1
               Zelle.Copy Sheets("Tabelle2").Cells(i2, 1)
            Next i1
        End If
    Next Zelle
End If
End Sub

Wie gesagt, da fehlt immer noch eine Fehlerroutine (wenn Du in Spalte A einen Buchstaben eingibst, erhältst Du eine Fehlermeldung) und der Bereich ("A1:A100") ist nicht flexibel.
Falls Du das noch brauchst und nicht selber hin bekommst, melde Dich nochmal.

1
Iamiam  15.10.2014, 13:57
@Oubyi, UserMod Light

Korrekturen hat immer der Teufel gesehen: Wenn Du eine Anzahl verringerst, bleiben die überzähligen Alt-Einträge stehen und müssen manuell entfernt werden. oder man entfernt per Makro hier automatisch die gesamten vorher gesetzten Spalteneinträge in Tabelle2 (führe ich aber jetzt nicht mehr aus, obwohl einfach möglich)
Deine Arbeit, das zu tun und das Makro neu zu starten ist sicherlich geringer als die Arbeit von Oubyi und ggf auch mir, das zu korrigieren (und auszuprobieren)...

1
Turtle1988 
Fragesteller
 15.10.2014, 14:02
@Oubyi, UserMod Light

Super, das funktioniert richtig toll. Ich hab den Modul- und Tabellencode für mich noch ein bissl modifiziert. Ich habe jetzt aber doch noch ein kleines Problem:

Tabellenblatt1
3 (Spalte A1) maus (Spalte B1)
2 (Spalte A2) katze (Spalte B2)

dann steht in Tabellenblatt2 folgendes:
maus
maus
maus
katze
katze

Alles soweit richtig. Ändere ich aber nun bspw in Tabellenblatt1 Spalte A1 von 3 auf 2, dann passiert folgendes in Tabellenblatt2:
maus
maus
katze
katze
katze

Es sollte aber egt so aussehen:
maus
maus
katze
katze

Also was muss am Code geändert werden, dass sozusagen alles in Tabellenblatt2 gelöscht und neu geschrieben wird?

0
Iamiam  15.10.2014, 15:45
@Turtle1988

möglicherweise hilft es, am Anfang von Oubyis Worksheet_change noch einen Löschbefehl zu setzen:
Worksheets("Tabelle2"),Range("A1:A999").clear 'oder clearcontents (erhält Formate)
Könnte aber sein, dass da erst mal ein Worksheets(..2).activate
und danach wieder ein
Worksheets(...1).activate
notwendig ist, probiers selber aus!

1
Oubyi, UserMod Light  15.10.2014, 23:31
@Iamiam

Stimmt, daran, dass die alten Einträge bei einer kürzeren Liste nicht gelöscht werden, hatte ich nicht gedacht.
Aber das sollte kein Problem sein (wie lamiam schon schreibt):

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
Sheets("Tabelle2").Range("A:A").ClearContents
    Dim Zelle As Range
    Dim i1 As Integer
    Dim i2 As Integer
    
    For Each Zelle In Sheets("Tabelle1").Range("B1:B100")
        If Not IsEmpty(Zelle) Then
            For i1 = 1 To Zelle.Offset(0, -1)
               i2 = i2 + 1
               Zelle.Copy Sheets("Tabelle2").Cells(i2, 1)
            Next i1
        End If
    Next Zelle
End If
End Sub

Um die Performance zu optimieren kannst Du den Lösch-Bereich auch eingrenzen:

Sheets("Tabelle2").Range("A1:A1000").ClearContents

1
Iamiam  16.10.2014, 00:00
@Oubyi, UserMod Light

ich grenze den neuerdings immer deshalb ein (v.a. bei Formeln), weil OO/LO kein A:A akzeptiert und daran die ansonsten einwandfreie Übersetzung scheitern kann (bzw Fehler stehen bleibt).
Bei Makros zZt für mich ü'flüssig, weil ich in LO eh noch nicht programmieren kann!

1