Hallo Leute,
ich benötige mal eure Hilfe bei der VBA Programmierung.
In einem Tabellenblatt kopiere ich eine Spalte mit allen Formeln und Formatierungen.
Die hinterlegten Formeln sind ein Verweis auf ein anderes Tabellenblatt.
'Firma 1'!$B$2 bis 'Firma 1!'$B$15
Dieser Eintrag muss über alle Zellen der Spalte geändert werden in 'Firma 2'!$B$2 - 'Firma 2'!$B$15
Irgendwie finde ich nicht die richtige Positionierung auf die neue Spalte und die Schleifenkonstruktion
zur Änderung des Eintrages.
Habe dieses Thema schon in Herbers-Excel-Forum gepostete aber bisher keine Antwort erhalten.
Die zugrundeliegende Tabelle füge ich im Anhang ein.
Hallo,
wie wäre es mit Suchen/Ersetzen??????
(Replace in VBA)
Hallo,
darüber habe ich auch schon nachgedacht. Leider befinden sich nach dem Kopiervorgang alle Formeln doppelt auf dem Tabellenblatt.
Ich müsste dazu erkennen können, welche der Formeln ersetzt werden muss.
Gruß Michael
Hallo,
Zitat:Leider befinden sich nach dem Kopiervorgang alle Formeln doppelt auf dem Tabellenblatt.
Ich weiß nicht was Du machst, aber es war keine Rede von kopieren! Ich würde alle Zellen, in denen die Formeln zu ändern sind, markieren und den Begriff
Firma 1 durch
Firma 2 ersetzen!
Hallo Edgar,
dies muss aber im Makro neue_Spalte_anlegen erfolgen und dann auch jedesmal wenn eine neue Spalte eingefügt wird.
Gruß Michael
Hallo,
hier mal ein funktionierender Code (als Entwurf!!!!):
Code:
Sub Neue_Spalte_anlegen()
Dim Spalte As Long
Dim Zeile As Long
Dim ZeileL As Long
Dim wks As Worksheet
Dim RNG As Range
Set wks = ActiveSheet
With wks
Spalte = .Cells(6, .Columns.Count).End(xlToLeft).Column
ZeileL = 24
Sheets("Muster").Copy After:=Sheets(Sheets.Count) 'Anlegen neues Tabellenblatt
Sheets(Sheets.Count).Name = "Firma " & .Cells(6, Spalte) + 1 'Rename neues Tabellenblatt
.Columns(Spalte + 1).EntireColumn.Insert shift:=xlToRight
.Cells(6, Spalte + 1) = Spalte
.Cells(7, Spalte + 1).FormulaLocal = "='Firma " & Spalte & "'!$A1"
Set RNG = .Range(.Cells(7, Spalte + 1), .Cells(ZeileL, Spalte + 1))
.Cells(7, Spalte + 1).AutoFill RNG
.Cells(7, Spalte + 2).FormulaLocal = "=Summe(B7:" & .Cells(7, Spalte + 1).Address(False, False) & ")"
Set RNG = .Range(.Cells(7, Spalte + 2), .Cells(ZeileL, Spalte + 2))
.Cells(7, Spalte + 2).AutoFill RNG
End With
End sub
Dazu darf in Deiner Übersicht am Anfang
nur die Spalte B gefüllt sein. Die Summenformeln werden automatisch rechts davon eingetragen!
Hallo Edgar,
ich habe deine Autofill-Funktion ausprobiert; Leider führt sie nicht zu dem Ergebnis welches ich mir wünsche. Das wird daran liegen, das ich dies nicht eindeutig beschrieben habe.
Daher noch mal die Anforderungen. Das Ergebnis, welches ich erreichen will habe ich in der Datei Ergebnis_Neue_Spalte_anlegen.jpg dargestellt.
1. Die Formatierung der 1.Spalte (Rahmen, Hintergrundfarbe, Schriftfarbe) muss erhalten bleiben.
2. Die schmalen Spalten die als Blocktrenner dienen dürfen nicht belegt werden.
3. Die Funktion muss über alle nicht belegten Spalten bis Spalte 12 funktionieren.
4. Die Verweise müssen von $A$1 - $A$20 definiert werden.
Wenn dir hierzu auch etwas einfällt, wäre ich dir dankbar.
Um eines möchte ich dich zur besseren Verständlichkeit des Lösungsvorschlages noch bitten. Dies würde sicher auch Anderen helfen die sich mit ähnlichen Problematiken beschäftigen und nicht so firm sind. Kannst du deine Lösungsvorschläge auskommentieren?
Gruß aus Hamburg
Michael
Hallo,
1. die Formatierung kann per Makro erfolgen, da kannst Du nachschlagen, wie man das macht und nach Bedarf einfügen!
2. Leerzeilen/-spalten mögen zwar der Optik dienen, erschweren aber die Bearbeitung ungemein. Da kann man mit der Rahmenstärke die gleichen Effekte erzielen.
3. a) welche Funktion, b) das funktioniert immer über die vorhandenen Spalten, wenn also neue Spalten eingefügt werden, passt sich das Ganze an!
4. da habe ich etwas übersehen. Werde ich drüber schauen, aber nicht mehr heute.
Wenn ich die Zeit (was leider selten der Fall ist) habe, werde ich kommentieren, wobei in diesem Code kaum etwas zu kommentieren wäre.
Wenn Du das Makro nicht als Ganzes übernimmst, passen die Funktionen auch nicht mehr.
Im Übrigen sind in Deinem Code folgende gravierende Mängel:
1. Du erstellst Formeln als Texte, daraus wird nie eine Formel.
2. Als erstes muß ein neues Tabellenblatt erstellt werden, ansonsten ergeben die Formeln einen Bezugsfehler.
Probier mal das:
[
attachment=7853]
Hallo Edgar,
mit deiner Lösung bin ich nun ein Stück weitergekommen.
Leider kann ich
.Columns(Spalte + 1).EntireColumn.Insert shift:=xlToRight
nicht gebrauchen da mir dadurch im Layout die Spalten N-P verschoben werden.
Gibt es nicht die Möglichkeit die Spalte B mit allen Formatierungen (Rahmen, Hintergrundfarbe) nur zu kopieren?
Wenn es dabei wieder zu Schwierigkeiten wegen er Blocktrenner kommt eventuell auch in 3 separaten Copy-Befehlen.
Du siehst derzeit nur eine Testversion in der ich verschiedene Ansätze durchprobiere. Die tatsächliche Anwendung ist
deutlich komplexer.
Falls du daran Interesse hast könnte ich sie dir über Dropbox zur Verfügung stellen. Hierzu benötige ich dann deine
Mail-Adresse.
Gruß aus Hamburg
Michael
P.S. Wenn du professionell mit VBA-Programmierung befasst bist, könnte ich bei entsprechender Zuarbeit ein Honorar auskehren.
Hallöchen,
mit diesem Makro werden die vorhandenen leeren Spalten überschrieben, sodass sich an der Struktur nichts ändert. Es wird nicht geprüft, ob nach der 12. Spalte durch den Anwender weitere Spalten erstellt werden. Die Formate werden so übertragen, wie sie in Spalte B angewendet werden. Wenn der "rechte" Rand z.B. durch Formatierung des "linken" Rand von Spalte C vorgenommen wird, fehlt er natürlich in der "neuen" Spalte.
Es gibt auch keine Fehlerbehandlung, falls das neue Blatt bereits vorhanden ist. In dem Fall erscheint die normale VBA-Fehlermeldung. Beim Testen also vorher ggf. Blätter löschen.
Code:
Sub Makro1()
'Variablendeklaration
Dim iMax As Integer
'Maximalwert aus Zeile 4 uebernehmen
iMax = WorksheetFunction.Max(Range("C4:L4"))
Sheets("Muster").Copy After:=Sheets(Sheets.Count) 'Anlegen neues Tabellenblatt
Sheets(Sheets.Count).Name = "Firma " & iMax + 1 'Rename neues Tabellenblatt
'Zurueck nach Blatt Uebersicht
Sheets("Übersicht").Activate
'Spalte B kopieren
Range("B4:B24").Copy
'Mit Spalte C versetzt um imax-1
With Range("C4").Offset(0, iMax - 1)
'Formeln einfuegen
.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Formate einfuegen
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'in eingefuegten Formeln Firma 1 durch Firma + iMax ersetzen
.Resize(21, 1).Replace What:="Firma 1", Replacement:="Firma " & iMax + 1, LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Kopiermodus ausschalten
Application.CutCopyMode = False
'Firmennummer eintragen
Range("C4").Offset(0, WorksheetFunction.Max(Range("C4:L4")) - 1).FormulaR1C1 = iMax + 1
'Ende Mit Spalte C versetzt um imax-1
End With
End Sub