Makro um Zellen nach unten zu kopieren

[napecs]

Hallo,

ich habe folgende Frage:

Ich habe eine Liste mit zwei Spalten und vorgegebenen Werten (gelb markiert):

Darunter sind jeweils 179 mal (hier als Beispiel nur 3) die gleichen Einträge, und zwar soll mit dem Dollar-Zeichen auf exakt diese gelben Zellen referenziert werden:

Das hat den Vorteil, dass man bei Änderungen nur die eine Zelle ändern muss. Ich muss nun knap 50.000 Zelle mit diesem Format füllen (d.h. die gelben Zellen sind bereits angelegt, ich muss nun die darunter liegenden, noch leeren 179 Zellen befüllen).


Kurz gesagt: ich brauche ein Makro das mir den Wert aus den zwei gelben Zellen in die darunter liegenden 179 Zellen gibt (mit dem "Dollar-Zeichen"). Ich habe es mit dem Makro-Rekorder probiert, leider erfolglos. Perfekt wäre z.B.: ich markiere Zelle A2, starte das Makro und es schreibt dann in A2 bis A4 sowie B2 bis B4 die Werte =$A$1 sowie $B$1. Weiter gehen würde es dann bei Zelle A6 und so weiter. Kann mir da jemand helfen? Danke !

 

[spcqike]

Hallo,

ganz grob versucht, wie folgt:

Sub Rechteck1_Klicken()
Dim i, a As Integer

Application.ScreenUpdating = False

For i = 1 To 20
If Cells(i, 1).Value > 0 Then
a = i
GoTo weiter:
End If
Cells(i, 1).Value = "=$A$" & a
Cells(i, 2).Value = "=$B$" & a
weiter:
Next

Application.ScreenUpdating = True

End Sub

funktioniert im Kleinen bis 20 bei mir wie gewollt.

bzw. nicht wie gewollt. Du musst die Zelle nicht erst anklicken. es reicht, das Makro einmal durchlaufen zu lassen. Es erkennt, ob in der Zelle Axx irgendetwas steht, wenn ja, wird die Formel so lange eingefügt, bis in A wieder etwas steht.

 

[Janush]

Brauchst ja eigentlich nur ein Makro welches durch alle Werte geht und wenn eine Zelle nicht leer ist deren Adresse übernimmt. Ungefäht so:

Public Sub FillDown()
Dim i As Long
Dim strTemp(2) As String

Const l As Integer = 3

With Sheet1
    For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row + l
        If .Cells(i, 1).Value = vbNullString Then
            .Cells(i, 1).Formula = strTemp(0)
            .Cells(i, 2).Formula = strTemp(1)
        Else
            strTemp(0) = "=" & .Cells(i, 1).Address
            strTemp(1) = "=" & .Cells(i, 2).Address
        End If
    Next i
End With
End Sub

Const l As Integer = 3 gibt dabei an wieviele Zeilen nach der letzten Zeile noch angehängt werden sollen.

Bevor ich es vergesse: Du musst das natürlich auf deine Bedürfnisse anpassen (Sheet1 vs. Tabelle1, usw.) :-)

 

[napecs]

Hallo ihr zwei, Danke auf jeden Fall für euer Hilfe, leider funktioniert beides nicht bei mir.

@spcqike: ich bekomme einen Laufzeitfehler bei der Stelle Cells(i, 1).Value = "=$A$" & a

@Janush: hier bekomme ich den Fehler bei
For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row + l
Den Wert "Const" habe ich auf 179 angepasst

 

[Janush]

Welchen Fehler? Und hast du auch die Referenz auf deine Tabelle richtig angepasst? Wo hast du das Makro reinkopiert?

Scheint für beide der selbe Fehler zu sein

 

[napecs]

"Laufzeitfehler 424: Objekt erforderlich"

Ich probiere es gerade nochmal. Wie müsste ich denn die Referenz anpassen? Also bei mir ist es auch die erste und zweite Spalte, das müsste also passen. Das Makro habe ich ganz normal in den Standard-Excel-VBA-Editor kopiert

 

[Janush]

naja Sheet1 wird es bei dir wahrscheinlich nicht geben, sondern Tabelle1. Das muss auf jeden Fall angepasst werden. Und dann würde ich den Code in ein extra Modul packen.

Im Bild siehst du worauf du referenzieren musst.

With .... wie auch immer deine Tabelle heist. Dabei zählt aber nur der erste Teil und nicht was in der Klammer steht.

 

[napecs]

Danke vielmals, es funktioniert nun ! Mein Rechner hat ganz schön zu schnaufen ;-) Danke !!!

 

[Janush]

Vielleicht kannst du noch Application.ScreenUpdating = False aus spcqikes Makro einbauen.

 

[napecs]

Ja das mache ich noch. Bisher flackert das Bild zwar nicht, aber wer weiß wie die Datei noch verändert wird.
Danke euch auf jeden Fall nochmal, sehr nett von euch !

 

[spcqike]

Das Bild flackert bei screenupdate auch nicht.

Ich würde mir bei dieser Tabelle ja mal den Spaß machen und gucken, welchen Zeitvorteil das deaktivieren bringt ich habe die Erfahrung gemacht dass das bereits bei wenigen Einträgen ( <5000) einen immensen Schub bringt.