Tipp: Formeln nach unten und/oder rechts kopieren

Reinhard_fb8cb7 · 31. März 2008 um 18:36

Hallo Interessierte,

zur Lösung einer Anfrage hier stand ich vor dem Problem, eine derartige Tabelle zu erzeugen:

Tabellenblatt: F:\[FormelKopieren.xls]!Tabelle2
 │ C │ D │ E │ F │ G │ H │ I │
───┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┤
 2 │ Mo │ Di │ Mi │ Do │ Fr │ Sa │ So │
───┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┤
 3 │ =Tabelle1!R$63 │ =Tabelle1!AF63 │ =Tabelle1!AT63 │ =Tabelle1!BH63 │ =Tabelle1!BV63 │ =Tabelle1!CJ63 │ =Tabelle1!CX63 │
───┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┤
 4 │ =Tabelle1!S63 │ =Tabelle1!AG63 │ =Tabelle1!AU63 │ =Tabelle1!BI63 │ =Tabelle1!BW63 │ =Tabelle1!CK63 │ =Tabelle1!CY63 │
───┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┤
 5 │ =Tabelle1!T63 │ =Tabelle1!AH63 │ =Tabelle1!AV63 │ =Tabelle1!BJ63 │ =Tabelle1!BX63 │ =Tabelle1!CL63 │ =Tabelle1!CZ63 │
───┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┤
 6 │ =Tabelle1!U63 │ =Tabelle1!AI63 │ =Tabelle1!AW63 │ =Tabelle1!BK63 │ =Tabelle1!BY63 │ =Tabelle1!CM63 │ =Tabelle1!DA63 │
───┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┤
 7 │ =Tabelle1!V63 │ =Tabelle1!AJ63 │ =Tabelle1!AX63 │ =Tabelle1!BL63 │ =Tabelle1!BZ63 │ =Tabelle1!CN63 │ =Tabelle1!DB63 │
───┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┤
 8 │ =Tabelle1!W63 │ =Tabelle1!AK63 │ =Tabelle1!AY63 │ =Tabelle1!BM63 │ =Tabelle1!CA63 │ =Tabelle1!CO63 │ =Tabelle1!DC63 │
───┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┤
 9 │ =Tabelle1!X63 │ =Tabelle1!AL63 │ =Tabelle1!AZ63 │ =Tabelle1!BN63 │ =Tabelle1!CB63 │ =Tabelle1!CP63 │ =Tabelle1!DD63 │
───┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┤
10 │ =Tabelle1!Y63 │ =Tabelle1!AM63 │ =Tabelle1!BA63 │ =Tabelle1!BO63 │ =Tabelle1!CC63 │ =Tabelle1!CQ63 │ =Tabelle1!DE63 │
───┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┤
11 │ =Tabelle1!Z63 │ =Tabelle1!AN63 │ =Tabelle1!BB63 │ =Tabelle1!BP63 │ =Tabelle1!CD63 │ =Tabelle1!CR63 │ =Tabelle1!DF63 │
───┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┤
12 │ =Tabelle1!AA63 │ =Tabelle1!AO63 │ =Tabelle1!BC63 │ =Tabelle1!BQ63 │ =Tabelle1!CE63 │ =Tabelle1!CS63 │ =Tabelle1!DG63 │
───┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┤
13 │ =Tabelle1!AB63 │ =Tabelle1!AP63 │ =Tabelle1!BD63 │ =Tabelle1!BR63 │ =Tabelle1!CF63 │ =Tabelle1!CT63 │ =Tabelle1!DH63 │
───┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┤
14 │ =Tabelle1!AC63 │ =Tabelle1!AQ63 │ =Tabelle1!BE63 │ =Tabelle1!BS63 │ =Tabelle1!CG63 │ =Tabelle1!CU63 │ =Tabelle1!DI63 │
───┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┤
15 │ =Tabelle1!AD63 │ =Tabelle1!AR63 │ =Tabelle1!BF63 │ =Tabelle1!BT63 │ =Tabelle1!CH63 │ =Tabelle1!CV63 │ =Tabelle1!DJ63 │
───┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┼────────────────┤
16 │ =Tabelle1!AE63 │ =Tabelle1!AS63 │ =Tabelle1!BG63 │ =Tabelle1!BU63 │ =Tabelle1!CI63 │ =Tabelle1!CW63 │ =Tabelle1!DK63 │
───┴────────────────┴────────────────┴────────────────┴────────────────┴────────────────┴────────────────┴────────────────┘

Tabellendarstellung erreicht mit dem Code in FAQ:2363

Mit Exceleigenen Möglichkeiten Formeln zu kopieren wäre mir das nicht möglich gewesen, ich hätte also ausgehend von C3 die anderen Formeln alle manuell ändern müssen.

Okay, mit Indirekt usw. wär das schon gegangen, aber ich entschied mich für eine Vba-Lösung. Diese Lösung sieht so aus, man markiert in dem Beispiel entweder C3:smiley:3, oder C3:C4 oder C3:smiley:4.
Demzufolge weiß das Makro ob man die Formel in C3 waagrecht, senkrecht oder auch über einen ganzen Bereich verteilen möchte.
Sind keine 2 oder 4 Zellen markiert, macht das Makro garnix.

Beispiel, ich möchte die Formel von C3 in einen Bereich kopieren.
Dann markiere ich C3:smiley:4 (D4 spielt keine Rolle, kann auch leer sein)

Tabellenblatt: F:\[FormelKopieren.xls]!Tabelle2
 │ C │ D │
──┼────────────────┼────────────────┤
3 │ =Tabelle1!R$63 │ =Tabelle1!AF63 │
──┼────────────────┼────────────────┤
4 │ =Tabelle1!S63 │ =Tabelle1!AG63 │
──┴────────────────┴────────────────┘

C4 und D3 geben dem Makro nur an wie groß der Versatz ist.
Im Makro selbst geben die Zahl „13“ (senkrecht) und „6“ (waagrecht) an wie groß der auszufüllende Bereich ist.
Dies ist vor Makrostart anzupassen.

Dann Makro starten, dann wird aus der unteren Tabelle die obige.

Und da Beschreiben absolut nicht zu meinen wenigen Stärken zählt, nun mal ein Beispiel das jeder nachvollziehen kann, auch wenn er nix mit Vba am Hut hat, aber vor dem Problem steht
er/sie möchte in Zelle G1 schreiben
=Tabelle2!A1
in G2
=Tabelle2!A7
in G3
=Tabelle2!A13
und dies bis runter zu G100.
Ohne Tricks findest du dann keine Kopierfunktion in Excel. Müßtest also alles manuell abändern.

Mit meiner Lösung mußt du nur einmalig
Alt+F11,Einfügen Modul, Code reinkopieren, im Code die 13 auf 100 abändern (kann auch 99 sein) , Editor schliessen

Dann die Formeln in G1 und G2 eintragen, G1:G2 markieren, Makro starten, fertig.

Gruß
Reinhard

Kristian_Zarse · 31. März 2008 um 22:08

Also man muss schon genau hingucken, um zu erkennen, was eigentlich die ursprüngliche Aufgabe war Und noch genauer muss man hingucken, um das Zaubermakro zu finden

Mit meiner Lösung mußt du nur einmalig
Alt+F11,Einfügen Modul, Code reinkopieren, im Code die 13 auf
100 abändern (kann auch 99 sein) , Editor schliessen

Nur ein Hinweis: Warum fragst Du diese Zahl nicht einfach per Inputbox ab? Dann muss man nicht in den Editor rein.

Kristian

Reinhard_fb8cb7 · 1. April 2008 um 18:59

Hi Kristian,

Also man muss schon genau hingucken, um zu erkennen, was
eigentlich die ursprüngliche Aufgabe war

ach, die war hier vor Tagen, daß ein Leuteschinder einteilen/sehen kann ob immer 15 Sklaven zur Frühschicht(8:00-14:00) und 20 zur Spätschicht(14:00-22:00) griffbereit sind.
Mein Lösungsversuch war gar nicht exakt auf die genaue Aufgabenstellung abgestimmt, leider mag hostarea auch heut nicht das Teil hochladen, dabei hat es nur 278 KB:frowning:

Und noch genauer
muss man hingucken, um das Zaubermakro zu finden

Mea Culpa Nachfolgend das Makro FormelKopieren

Mit meiner Lösung mußt du nur einmalig
Alt+F11,Einfügen Modul, Code reinkopieren, im Code die 13 auf
100 abändern (kann auch 99 sein) , Editor schliessen

Nur ein Hinweis: Warum fragst Du diese Zahl nicht einfach per
Inputbox ab? Dann muss man nicht in den Editor rein.

Ja, ist sicher einfacher, ich dachte auch daran möglichst den Ablauf beim normalen Formelkopieren nachzubauen, also erst 2-4 zellen markieren, eine Tastenkombination drücken, Zielbereich markieren, einfügen, aber wenn dann später *gg*, ist grad nur so entwickelt daß es grad so läuft.

Option Explicit
Public dZs, dSs, Fehlzelle
'
Sub FormelKopieren()
Dim B As String, A As String, Bereich As Range, N As Integer, AZ As String
On Error GoTo Fehler
Set Bereich = Selection
If Bereich.Cells.Count 4 And Bereich.Cells.Count 2 Then Exit Sub
Application.ScreenUpdating = False
With ActiveSheet
 B = Blatt(Bereich(1, 1).FormulaLocal)
 A = Adresse(Bereich(1, 1).FormulaLocal)
 AZ = Adresse(Bereich(2, 1).FormulaLocal)
 dZs = .Range(AZ).Row - .Range(A).Row
 dSs = .Range(AZ).Column - .Range(A).Column
 If Bereich.Rows.Count = 2 Then Call Senkrecht(B, A, Bereich, 13)
 If Bereich.Columns.Count = 2 Then Call Waagrecht(B, A, Bereich, 6)
 If Bereich.Cells.Count = 4 Then
 For N = 1 To 6
 Set Bereich = Bereich.Offset(0, 1)
 A = Adresse(Bereich(1, 1).FormulaLocal)
 Call Senkrecht(B, A, Bereich, 13)
 Next N
 End If
End With
Exit Sub
Fehler:
 Application.ScreenUpdating = True
 MsgBox "Fehler " & Err.Number & " aufgetreten " & Chr(13) & Err.Description
End Sub
'
Sub Senkrecht(B, A, Bereich, Anzahl)
Dim AnzZ As Long
With ActiveSheet
 For AnzZ = 1 To Anzahl
 Bereich(1, 1).Offset(AnzZ, 0).FormulaLocal = "=" & IIf(Len(B) \> 0, B & "!", "") & Range(A).Offset(AnzZ \* dZs, AnzZ \* dSs).Address(0, 0)
 Next AnzZ
End With
End Sub
'
Sub Waagrecht(B, A, Bereich, Anzahl)
Dim ASp As String, dZ As Long, dS As Integer, AnzS As Integer
With ActiveSheet
 ASp = Adresse(Bereich(1, 2).FormulaLocal)
 dZ = .Range(ASp).Row - .Range(A).Row
 dS = .Range(ASp).Column - .Range(A).Column
 For AnzS = 1 To Anzahl
 Bereich(1, 1).Offset(0, AnzS).FormulaLocal = "=" & IIf(Len(B) \> 0, B & "!", "") & Range(A).Offset(AnzS \* dZ, AnzS \* dS).Address(0, 0)
 Next AnzS
End With
End Sub
'
Function Blatt(Formel As String)
Dim F As String
F = Mid(Formel, 2)
If InStr(F, "!") \> 0 Then
 Blatt = Left(F, InStr(F, "!") - 1)
End If
End Function

Function Adresse(Formel)
Adresse = Mid(Formel, 2) ' "=" raus
If InStr(Adresse, "!") \> 0 Then
 Adresse = Mid(Adresse, InStr(Adresse, "!") + 1)
End If
End Function