Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Formatierung der Zellen mit VBA Makro





Frage

Hallo, Meine Frage ist ob es Möglich ist alle Zellen die von der einen Tabelle in eine Ausgabe Tabelle Kopiert wurden in der Ausgabe einen Rahmen um die Zelle tragen können, bzw wie macht man das. Allerdings sollen die Formatierungen nur in dieser Ausgabe Tabelle stattfinden Die Formatierung soll nicht in die Tabelle übertragen werden woher die Daten stammen. das geschieht ja meistens Automatisch.

Antwort 1 von coros

Hi nasselieny,

warum bleibst Du nicht bei dem Beitrag, den Du bereits in der Gruppe VBScript/Javascript eröffnet hast. Das wird nur alles sehr unübersichtlich, was Du nun machst. Nachfolgend noch mal meine Antwort, die ich bereits in der genannten Gruppe gegeben habe. Wenn Du möchtest, dass ein Beitrag verschoben wird, dann schicke den Admins eine Nachricht über den Button "
[Missbrauch und Fehler melden] " ganz oben in Deinem Beitrag. Die werden dass dann veranlassen.

Nun zu Deiner Frage. Kopierst Du nur einzelne Zellen nacheinander oder auch ganze Bereiche?

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 2 von CaroS

Hallo Nasselieny,

die primitive Antwort lautet ja, es ist möglich und es geht - beim Kopieren per Hand - ganz einfach.

Du hast also die Zellen/ Zeilen/Spalten/Bereiche in Deiner Ausgangstabelle markiert, mit Bearbeiten -- Kopieren in die Zwischenablage eingefügt, hast die Zieltabelle geöffnet, dort evtl. einen Zielbereich markiert und den Inhalt der Zwischenablage dort irgendwie eingefügt (über Bearbeiten -- Einfügen oder über Bearbeiten -- Inhalte einfügen...) und sonst noch nichts weiter getan, nicht den kleinsten Klick!

Dann sind die eben eingefügten Zellen alle noch markiert und es ist ein leichtes, sie nun über Format -- Zellen... -- Rahmen -- (Linien Art: ? Linien Farbe: ? --) Außen -- Innen -- OK mit äußeren und inneren Linien zu umrahmen.

Wenn Du jetzt noch nicht genug hast und auch immer noch nirgendwo geklickt hast, kannst Du mit jeder beliebigen Formatierung der Zellen/Zeilen/Spalten weitermachen, bis Du irgendwann die Markierung mal aufhebst und dann u. U. nicht mehr genau weißt, welche Zellen durch den letzten Kopiervorgang übertragen wurden. Dann ist´s vorbei!

Zwar bleibt bis zur Aufhebung der Markierung der eingefügten Zellen auch die Markierung der kopierten Zellen in der Ausgangstabelle erhalten, diese sind aber - zumindest bei mir (Excel 2002) - von den durchgeführten Formatierungen nicht betroffen.

Siehst Du da noch irgendein Problem?

Gruß,
CaroS

Antwort 3 von coros

Hallo CaroS,

schön vie geschrieben, aber ich würde sagen, wenn ich mir die Überschrift der Frage mal ansehe (Formatierung der Zellen mit VBA Makro) har scharf an dem Problem vorbei geschrammt. ;-) Ich glaube mal, das @Nasselieny wohl eher an einem VBA Code interessiert war/ ist und nicht an dem, wie man üblicherweise einen Rahmen um eine Zelle bekommt.

So ein Code könnte z.B. folgendermaßen aussehen:

Private Sub Worksheet_Change(ByVal Target As Range)
With Target.Cells
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
End With
End Sub


Hier wird immer um die Zelle, in der eine Änderung durch das Kopieren eintritt, ein Rahmen erstellt.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 4 von Nasselieny

Einen schönen Montag Morgen erstmal,

also erstmal Danke an Caros allerdings hat der Oliver wohl Recht ich brauch eínen VBA Code,


Den Code den du mir hier geschickt hast, funktioniert allerdings nicht er nimmt die erste Zeile nicht an.

Worksheet_Change(ByVal Target As Range)

entweder erwartet er ein Listentrennzeichen, wenn ich ihm das gebe einen Ausdruck oder er sagt mir das Objekt ist nicht definiert.

Liebe Grüße Nadine

Antwort 5 von coros

Hi Nadine,

ich weiß nicht, wo Du den Code hinkopiert hast, oder was Du daran geändert hast, aber der von mir aufgeführte Code gehört in das VBA Projekt des Tabellenblattes, in das die Daten kopiert werden sollen. Also in Deinem Fall in das Ausgabeblatt.

Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 2 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 6 von Nasselieny

Danke ich schau mal nach!

Antwort 7 von nasselieny

Also ich muss leider sagen es hilft mir nicht wirklich weiter,

ich habe das Problem ich kann es nicht in die Tabelle schreiben in die der Code wirken soll, denn die ensteht erst durch den Code.

es werden daten Aus der TAbelle daten kopiert sie werden in die Tabelle Ausgabe geschrieben die extra dafür angelegt wird von dem makro selbst und in der Ausgabe der kopierten daten wird die Formatierung und die Position in der tabelle geändert sonst nichts also um es übersichtlicher zu gestalten soll um jede zelle die inhalt trägt, ein rahmen gesetzt werden.

Antwort 8 von coros

Hallo Nadine,

kommen also alle Daten die sich in dem neuen Tabellenblatt befinden aus einer Datei? Man könnte das mit in Dein vorhandenes Makro mit einarbeiten. Man könnte nach dem Kopierbefehl um die Zelle, in das der Wert kopiert wurde den Rahmen setzen. Dafür benötigt man aber erst mal Dein Makro, damit man sich das mal ansehen kann, wo man das implementieren könnte. Kopiere bitte mal Dein Makro hier hinein, damit man sich das ansehen kann.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 9 von Nasselieny

Sub PivotBericht()
Dim Wiederholungen As Integer, Blatt_vorhanden As Boolean, Paste As Integer, i, j As Double, Zelle As Range, Zeile As Range, ZeilenNr As Integer, Target As Range

Application.ScreenUpdating = False ´Keine Sichtbare Aktualisierung

Workbooks("Master_RLI_GJPlanung05_06__test").Activate

For Wiederholungen = 1 To Worksheets.Count
If Sheets(Wiederholungen).Name = "Ausgabe" Then
Blatt_vorhanden = True
End If
Next
If Blatt_vorhanden = False Then
With Worksheets.Add
.Name = "Ausgabe"
.Move After:=Sheets(Worksheets.Count)
End With
End If
j = 0
ZeilenNr = 0
For i = 5 To Worksheets("Pivot").Cells(Rows.Count, 1).End(xlUp).Row Step 1
If Worksheets("Ausgabe").Range("A5").Value = "" Then
Worksheets("Pivot").Cells(i, 1).Copy
Worksheets("Ausgabe").Select
Range("A5").Select
ActiveCell.PasteSpecial xlPasteValues
ActiveCell.PasteSpecial xlPasteFormats
Worksheets("Pivot").Select
Range(Cells(4, 2), Cells(4, 11)).Copy
Worksheets("Ausgabe").Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Worksheets("Ausgabe").Range("B4").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Worksheets("Pivot").Select
Range(Cells(i, 2), Cells(i, 11)).Copy
Worksheets("Ausgabe").Range("C4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Worksheets("Ausgabe").Range("C4").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

Antwort 10 von Nasselieny

Else:
Worksheets("Pivot").Cells(i, 1).Copy
Worksheets("Ausgabe").Select
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(j, 0).PasteSpecial xlPasteValues
ActiveCell.PasteSpecial xlPasteFormats
Worksheets("Pivot").Select
Range(Cells(4, 2), Cells(4, 11)).Copy
Worksheets("Ausgabe").Select
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Worksheets("Pivot").Select
Range(Cells(i, 2), Cells(i, 11)).Copy
Worksheets("Ausgabe").Select
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
j = 11
GoTo next1
End If
j = 11
next1:
Next i

For Each Zelle In ActiveSheet.UsedRange
Select Case Zelle
Case "WB"
Zelle.Interior.ColorIndex = 1
Case "KF"
Zelle.Interior.ColorIndex = 1
Case "Z"
Zelle.Interior.ColorIndex = 1
Case "ZF"
Zelle.Interior.ColorIndex = 1
Case "FAL"
Zelle.Interior.ColorIndex = 1
Case "ELO"
Zelle.Interior.ColorIndex = 1
Case "ZiNi"
Zelle.Interior.ColorIndex = 1
Case "Dünnfilm"
Zelle.Interior.ColorIndex = 1
Case "Bondal"
Zelle.Interior.ColorIndex = 1
End Select
Next

For i = 15 To Worksheets("Ausgabe").Cells(Rows.Count, 1).End(xlUp).Row Step 11
Worksheets("Ausgabe").Rows(i).Interior.ColorIndex = 1
Next

Application.ScreenUpdating = True ´ Bildschirmaktualisierung aktivieren
Columns("A:B").EntireColumn.AutoFit
Columns("C:C").ColumnWidth = 12.14
Range("A1").Select

MsgBox "Die neue Formatierung der Konzerne" & Chr(13) & "wurde in der Tabelle ´Ausgabe´ erstellt", vbOKOnly, "Powered by ThyssenKrupp Stahl AG"
End Sub

Das ist der gesamte Quellcode, die Daten kommen aus dem Tabllenblatt "Pivot" Und werden in das Tabellenblatt "Ausgabe" kopiert. Es ist eine Datei mit mehreren Tabellenblättern.
Es ist nur der Inhalt der aus dem Tabellenblatt "Pivot", in ein neu erstelltes Tabellenblatt "Ausgabe" kopiert wird.

Und nur Der Inhalt der nachher in das Tabellenblatt Ausgabe kopiert wurde soll, diesen Rahmen tragen.

Die Pivot Tabelle soll so bleiben wie sie vorher war da soll sich nichts ändern.

Antwort 11 von coros

Hallo Nadine,

nachfolgendes Makro sollte das machen, was Du Dir vorgestellt hast. Ich habe den gesamten Code etwas eingekürzt, in dem ich in dem gesamten Code die vielen Select-Anweisungen herausgelöscht habe. Diese werden zu 99,9% nicht benötigt und klauen dem Rechner nur Rechenleistung.

Das Makro sollte auch bei Dir funktionieren. Bei meinen Testversuchen lief es ohne Probleme durch. Aufgrund der Länge des Makros und der Begrenzung auf 5000 Zeichen komme ich genau wie Du an die Grenze. Deshald folgt das Makro im nächsten Beitrag. Solltest Du Probleme mit dem Makro haben melde Dich bitte.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 12 von coros

Sub PivotBericht()
Dim Wiederholungen As Integer, Blatt_vorhanden As Boolean, Paste As Integer, i, j As Double, Zelle As Range, Zeile As Range, ZeilenNr As Integer, Target As Range

Rem: Keine Sichtbare Aktualisierung
Application.ScreenUpdating = False
Workbooks("Master_RLI_GJPlanung05_06__test").Activate

For Wiederholungen = 1 To Worksheets.Count
If Sheets(Wiederholungen).Name = "Ausgabe" Then
Blatt_vorhanden = True
End If
Next
If Blatt_vorhanden = False Then
With Worksheets.Add
.Name = "Ausgabe"
.Move After:=Sheets(Worksheets.Count)
End With
End If
j = 0
ZeilenNr = 0
For i = 5 To Worksheets("Pivot").Cells(Rows.Count, 1).End(xlUp).Row Step 1
If Worksheets("Ausgabe").Range("A5").Value = "" Then
Worksheets("Pivot").Cells(i, 1).Copy
With Worksheets("Ausgabe").Range("A5")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
End With
Worksheets("Pivot").Range(Cells(4, 2), Cells(4, 11)).Copy
Worksheets("Ausgabe").Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
With Worksheets("Ausgabe").Range("B4:B13")
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
Worksheets("Pivot").Range(Cells(i, 2), Cells(i, 11)).Copy
Worksheets("Ausgabe").Range("C4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
With Worksheets("Ausgabe").Range("C4:C13")
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With

Else:
Worksheets("Pivot").Cells(i, 1).Copy
With Worksheets("Ausgabe").Range("A65536").End(xlUp)
.Offset(j, 0).PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
End With

Worksheets("Pivot").Range(Cells(4, 2), Cells(4, 11)).Copy
Worksheets("Ausgabe").Range("A65536").End(xlUp).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

Worksheets("Pivot").Range(Cells(i, 2), Cells(i, 11)).Copy
Worksheets("Ausgabe").Range("A65536").End(xlUp).Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

With Worksheets("Ausgabe").Range("B" & Worksheets("Ausgabe").Range("A65536").End(xlUp).Row & ":C" & Worksheets("Ausgabe").Range("A65536").End(xlUp).Row + 9)
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
j = 11
GoTo next1
End If
j = 11
next1:
Next i

For Each Zelle In ActiveSheet.UsedRange
Select Case Zelle
Case "WB"
Zelle.Interior.ColorIndex = 1
Case "KF"
Zelle.Interior.ColorIndex = 1
Case "Z"
Zelle.Interior.ColorIndex = 1
Case "ZF"
Zelle.Interior.ColorIndex = 1
Case "FAL"
Zelle.Interior.ColorIndex = 1
Case "ELO"
Zelle.Interior.ColorIndex = 1
Case "ZiNi"
Zelle.Interior.ColorIndex = 1
Case "Dünnfilm"
Zelle.Interior.ColorIndex = 1
Case "Bondal"
Zelle.Interior.ColorIndex = 1
End Select
Next

For i = 15 To Worksheets("Ausgabe").Cells(Rows.Count, 1).End(xlUp).Row Step 11
Worksheets("Ausgabe").Rows(i).Interior.ColorIndex = 1
Next

Rem: Bildschirmaktualisierung aktivieren
Application.ScreenUpdating = True
With Worksheets("Ausgabe")
.Columns("A:B").EntireColumn.AutoFit
.Columns("C:C").ColumnWidth = 12.14
End With

MsgBox "Die neue Formatierung der Konzerne" & Chr(13) & "wurde in der Tabelle ´Ausgabe´ erstellt", vbOKOnly, "Powered by ThyssenKrupp Stahl AG"
End Sub


Antwort 13 von nasselieny

Hallo Oliver

Sorry aber muss dir leider sagen das es nicht funktioniert er geht zwar in die schleife rein beginnt auch mit der Formatierung des rahmens allerdings hängt er bei wer Worksheets zeile

Worksheets("Pivot").Range(Cells(4, 2), Cells(4, 11)).Copy

In der For wie auch in der Else Anweisung.

És heisst Anwendungs oder Objektorientierter Fehler
´1004´

Vielleicht ist das eine Hilfe.

Weiss nicht warum er das nicht annimmt. hab aber vielleicht a uch mittlerweile ein Brett vorm Kopf.

Antwort 14 von coros

Hi nasselieny,

das muss irgendwie an Deiner Datei liegen. Ich habe das Makro ja bei mir laufen lassen, ohne das es zu Problemen kam. Allerdings habe ich natürlich keine Beispieldatei erstellt, die ähnlich Deiner ist. Im Moment fällt mir leider auch nicht so richtig etwas dazu ein. Was für eine Excelversion verwendest Du? Excel97, Excel2000, Excel2002, Excel2003?

Besteht die Möglichkeit mir Deine Datei mal zukommen zu lassen? Es dürfen auch alle Daten, die mich nichts anzugehen haben, gelöscht werden. Allerdings wäre ich Dir sehr dankbar, wenn Du anstelle der Daten ein paar Dummydaten einsetzen würdest. Also wenn Du willst, dann schikce mir bitte mal die Datei. Die E-Mailadresse findest Du auf meiner HP u. a. im Impressum. Binde in der Betreffzeile irgendwie das Wort "Supportnet" und den Namen (Nickname), unter dem Du hier gepostet hast mit ein, da ich alle Mails deren Absender ich nicht kenne, ungelesen lösche.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: