Datenabgleich obere Linie weg

20.11.2024 14:17:06

Tom

Hallo zusammen,

ich habe hier letztes Jahr eine tolle Lösung erhalten.
Nun möchte ich es optisch anpassen, komme aber alleine damit nicht klar .....

Ich habe einen Reiter eingefügt, wie es jetzt aussehen soll.
Es wäre super, wenn man mir die Änderung erklären kann :-)
Danke vorab

https://www.herber.de/bbs/user/173733.xlsm

Viele Grüße
TOM

AW: Datenabgleich obere Linie weg

20.11.2024 18:02:41

Tom

Hallo habe noch eine Alternative dazu geschrieben falls Version 1) nicht umsetzbar sein sollte

https://www.herber.de/bbs/user/173740.xlsm

Gruß
TOM

AW: Datenabgleich obere Linie weg

20.11.2024 20:20:43

Udo D.

Guten Abend Tom,

dass ich dich richtig verstehe, möchte deine Excelkenntnisse nicht kritisieren oder verspotten,
nur klingt diese Frage eigentlich zu banal und so richtig geschrieben was du willst hast du eigentlich auch nicht.
Klar du zeigst eine Tabelle mit drei Bereichen vorher nachher usw.

Aber sag doch mal was zu deinem Prozedere, wie du damit vorgehen willst, geht es dir "nur" um das händische
Abarbeiten über Rechtsklick auf eine Zelle, dann "Zellen formatieren" und in den dort auftauchenden Registern
kannst du dann die Zelle / ihre Erscheinung individuell gestalten, Text, Rahmen "deine Linien" und Füllung.

Oder hast du szs. noch Defizite bzgl. der "lediglichen" Zellformatierung ?
Beschreib mal dein Handeln etwas, damit man dir die passende Lösung anbieten kann. Benötigst du einfach
noch Kenntnisse wie man sich so eine Zelle direkt gestaltet, soll das Erscheinungsbild in Abhängigkeiten sich automatisch
anpassen usw. oder per Makro ???

LG Udo

AW: Datenabgleich obere Linie weg

21.11.2024 00:49:41

Tom

Hallo Udo,

ich versuche es nochmal besser zu erklären, was ich gerne hätte:

Im Reiter „Alle Infos“ trägt man die Daten ein, die dann per Makro auf das Tabellenblatt „Datenabgleich“ untereinander dargestellt werden. Das klappt alles prima.

Mein Wunsch ist es nun, dass die übertragenen Daten automatisch so formatiert werden wie von mir im Tabellenblatt „So soll es aussehen“ dargestellt.

Es soll also nicht „händisch“ eingegriffen werden (PS das bekomme ich tatsächlich hin) sondern es soll per Makro automatisiert passieren.

Ich freue mich auf Deinen Lösungsansatz

Viele Grüße
Tom

AW: Datenabgleich obere Linie weg

22.11.2024 15:38:27

Udo D.

Hallo Tom,
hatte bislang noch keine zeit erneut reinzuschauen, hab heute Abend etwas Zeit und schick dir später noch was
LG Udo

... hier also mal etwas bescheidene Code Ansätze meinerseits

22.11.2024 23:43:05

Udo D.

Sub Makro5() ' abarbeiten versch. Linienformate mit direkter Ansprache
'Kürzen 01
[A2:B25].Borders(xlEdgeRight).Color = RGB(225, 120, 80)
[A2:B25].Borders(xlEdgeLeft).Color = RGB(225, 120, 80)
[A2:B25].Borders(xlEdgeTop).Color = RGB(225, 120, 80)
[A2:B25].Borders(xlEdgeBottom).Color = RGB(225, 120, 80)
[A2:B25].Borders(xlInsideVertical).Color = RGB(225, 120, 80)
[A2:B25].Borders(xlInsideHorizontal).Color = RGB(225, 120, 80)
' [A2:B25].Borders.Weight = xlThin ' Linie dünnerer Stärke
[A2:B25].Borders.Weight = xlMedium ' Linie mittlerer Stärke
' [A2:B25].Borders.Weight = xlThick ' Linie dickerer Stärke

'Hi Tom, also so würde > ich den Code ansetzen wenn es um
'Zellformatierung geht. Über die RGB Werte kann ich es besser einstellen.
'und dein ganzer aufgezeichneter Anhang ist zum Größten Teil
'alles zwar korrekt aufgezeichnet, aber im Prinzip letztlich unnötigt.
'Die ganzen Passagen die Excel szs. nicht formatiert oder mit Null
'ansetzt, kannst du im Prinzip rauslöschen, auch die With Anweisungen
'an den Stellen würde ich ebenfalls hier rauskürzen. Das geht über so direkte
'Anweisungen schneller und kompakter.
End Sub

Sub Makro6()
'Kürzen 02
[A2:B25].Borders.Weight = xlMedium ' Linie mittlerer Stärke
[A2:B25].Borders(xlInsideVertical).Color = RGB(150, 150, 150)
[A2:B25].Borders(xlInsideHorizontal).Color = RGB(150, 150, 150)
[A2:B25].BorderAround LineStyle:=xlContinuous, Weight:=xlMedium, Color:=RGB(150, 150, 150)
End Sub

Sub Makro7()
' Ansatz mit bereits formatiertem Bereich als Vorlage zur Übernahme "nur" dieser Formatierungen via Paste Spezial
Range("F2:G25").Copy
Range("A2:B25").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

Sub Makro8()
' Zellen verbinden A2+A3
Application.DisplayAlerts = False
[A2:A3].Merge
[A2].Font.Size = 48
[A2].Font.Bold = True
[A2].HorizontalAlignment = xlCenter ' text horiz. mittig setzen
'[A2].VerticalAlignment = xlCenter ' hier unnötig
Application.DisplayAlerts = True
End Sub

Sub Makro9() 'dein Wunschformat umgesetzt mit direkter Anweisung
'( das Ganze kannst natürlich auch noch in Schleife umsetzen mit for ... i.. usw. )
'wie gesagt, dein Prozedere kann ich noch nicht ganz nachvollziehen ...

'nun mal dein Anspruch direkt auf z.B. A2-B25 angewiesen / nur das Nötige hierzu zusammengesetzt
Application.ScreenUpdating = False ' True unterhalb nicht nötig
[A2:B25].Borders.LineStyle = xlNone 'zunächst alle gesonderte evtl. Linien Formate entnehmen

[A4:B25].Borders.Weight = xlMedium ' Linie mittlerer Stärke
[A4:B25].Borders(xlInsideVertical).Color = RGB(150, 150, 150)
[A4:B25].Borders(xlInsideHorizontal).Color = RGB(150, 150, 150)
[A4:B25].BorderAround LineStyle:=xlContinuous, Weight:=xlMedium, Color:=RGB(150, 150, 150)

'Range("B2:B3").Borders.LineStyle = xlNone
Application.DisplayAlerts = False
[A2:A3].Merge
[A2].Font.Size = 48
[A2].Font.Bold = True
[A2].HorizontalAlignment = xlCenter ' text horiz. mittig setzen
'[A2].VerticalAlignment = xlCenter ' hier unnötig
Application.DisplayAlerts = True

[A2:B3].BorderAround LineStyle:=xlContinuous, Weight:=xlThick, Color:=RGB(150, 150, 150)
[D25].Select ' nur spasseshalber
End Sub

Damit kannst ja schon mal eine Stufe weiter experimentieren und testen, für mehr musst du mehr
sagen wie was genau ablaufen soll, ich persönlich finde hier die Gesch. mit paste.spezial fast am Besten
da die sich ggf. auch einfach in eine Schleife setzen liese ... so ich mich nicht ganz täusche,
Jetzt bist erst mal du wieder an der Reihe.
Grüße Udo

dein vermtl. gesuchter Code - in der Schleife eingepasst

23.11.2024 01:12:00

Udo D.

Bsp. Datei : https://www.herber.de/bbs/user/173779.xlsm

der Code zur Formatübernahme in die erzeugten Blöcke nach deinem Beispiel :
LG Udo

Option Explicit

Sub sbInfoToData()

Dim lshInfo As Worksheet, lshData As Worksheet
Dim lloDataNext As Long
Dim lloInfoRow As Long

'ohne Set lshInfo = ... müsstest du überall anstelle von "lshInfo." den Befehl "Sheets("Alle Infos")." schreiben ,
'anstelle von nur 7 also immer wieder 21 Zeichen, außerdem, so finde ich, bleibt es mit Set ... = ... übersichtlicher

Set lshInfo = Sheets("Alle Infos") 'wenn Blattname im Original anders, dann hier anpassen
Set lshData = Sheets("Datenabgleich") 'wenn Blattname im Original anders, dann hier anpassen

Application.ScreenUpdating = False ' Bildschirm-Flackern ausgeschaltet
Application.EnableEvents = False
Application.DisplayAlerts = False

lloDataNext = 2 'Startzeile für Einträge in "Datenabgleich"
lshData.Cells.Delete Shift:=xlUp 'alle Zeilen, Spalten, Werte, Formate, Rahmenlinien in "Datenabgleich" werden gelöscht

With lshInfo 'Befehle für TAB "Alle Infos"

For lloInfoRow = 3 To .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(2, 1), .Cells(2, .Cells(2, .Columns.Count).End(xlToLeft).Column)).Copy ' die Überschriftenzeile mit "Text1","Text2", usw wird kopiert...
lshData.Range("A" & lloDataNext).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True ' ...und im Blatt "Datenabgleich" in SPALTE A eingefügt
.Range(.Cells(lloInfoRow, 1), .Cells(lloInfoRow, .Cells(lloInfoRow, .Columns.Count).End(xlToLeft).Column)).Copy ' jede Datenzeile aus "Alle Infos", beginnend ab Zeile 3, wird kopiert...
lshData.Range("B" & lloDataNext).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True ' ...und im Blatt "Datenabgleich" in SPALTE B eingefügt

With lshData.Range("A" & lloDataNext & ":B" & lshData.Cells(lshData.Rows.Count, 1).End(xlUp).Row) 'ab hier werden in "Datenabgleich" alle Formatierungen angepasst

With .Font 'Schriftgröße in Spalte A + B wird festgelegt und Schrifttext wird fett dargestellt
.Size = 22
.ColorIndex = xlAutomatic
.Bold = True
End With

.Interior.Pattern = xlNone 'Hintergrundfarbe gelb wird entfernt
End With

lshData.Range("B" & lloDataNext).Font.Size = 36 'nur die jeweils erste Zeile eines Datenblocks in "Datenabgleich" hat eine größere Schriftgröße

With lshData.Range("B" & lloDataNext & ":B" & lshData.Cells(lshData.Rows.Count, 1).End(xlUp).Row) 'Ausrichtung in "Datenabgleich" für Spalte B wird festgelegt
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
' -------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' neuer zusätzl. Abschnitt : ( Gruß Udo )
' hier nun die direkten Anweisungen in der vorhandenen For/Next Schleife sodass jeder erzeugte Block entspr. verarb. wird
lshData.Range("A" & lloDataNext & ":B" & lshData.Cells(lshData.Rows.Count, 1).End(xlUp).Row).Borders.LineStyle = xlNone
lshData.Range("B" & lloDataNext + 1 & ":B" & lshData.Cells(lshData.Rows.Count, 1).End(xlUp).Row).Font.Bold = False 'die jeweils erste Zeile eines Datenblocks in "Datenabgleich" fett dargestellt

lshData.Range("A" & lloDataNext + 2 & ":B" & lshData.Cells(lshData.Rows.Count, 1).End(xlUp).Row).Borders.Weight = xlMedium ' Linie mittlerer Stärke
lshData.Range("A" & lloDataNext + 2 & ":B" & lshData.Cells(lshData.Rows.Count, 1).End(xlUp).Row).Borders(xlInsideVertical).Color = RGB(150, 150, 150)
lshData.Range("A" & lloDataNext + 2 & ":B" & lshData.Cells(lshData.Rows.Count, 1).End(xlUp).Row).Borders(xlInsideHorizontal).Color = RGB(150, 150, 150)
lshData.Range("A" & lloDataNext + 2 & ":B" & lshData.Cells(lshData.Rows.Count, 1).End(xlUp).Row).BorderAround LineStyle:=xlContinuous, Weight:=xlMedium, Color:=RGB(150, 150, 150)
lshData.Range("A" & lloDataNext & ":B" & lshData.Cells(lshData.Rows.Count, 1).End(xlUp).Row - 22).BorderAround LineStyle:=xlContinuous, Weight:=xlThick, Color:=RGB(150, 150, 150)

'oberste Blockzeile in A
lshData.Range("A" & lloDataNext & ":A" & lshData.Cells(lshData.Rows.Count, 1).End(xlUp).Row - 22).Merge 'die obersten beiden in A vereinen
lshData.Range("A" & lloDataNext & ":A" & lshData.Cells(lshData.Rows.Count, 1).End(xlUp).Row - 22).Font.Size = 48 'die vereinte Zelle Fontgröße
lshData.Range("A" & lloDataNext & ":A" & lshData.Cells(lshData.Rows.Count, 1).End(xlUp).Row - 22).Font.Bold = True 'die vereinte Zelle Font fett
lshData.Range("A" & lloDataNext & ":A" & lshData.Cells(lshData.Rows.Count, 1).End(xlUp).Row - 22).HorizontalAlignment = xlCenter ' die vereinte Zelle Text horiz. mittig setzen

' -------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'die Startzeile für den nächsten Datenblock wird festgelegt - immer 5 Zeilen unterhalb der letzten Zeile vom vorherigen Datenblock
lloDataNext = lshData.Cells(lshData.Rows.Count, 1).End(xlUp).Row + 5
Next

End With

'Spaltenbreite für Spalte A + B werden festgelegt
lshData.Columns("A:A").ColumnWidth = 50
lshData.Columns("B:B").ColumnWidth = 121

'Zeilenhöhe wird festgelegt
lshData.Rows("1:" & lshData.Cells(lshData.Rows.Count, 1).End(xlUp).Row).RowHeight = 54

Application.Goto lshData.Range("A1"), True

'Bildschirmflackern und das Starten von Aktionen, wie z Bsp Zellwertänderungen, wird wieder ein und die CopyPaste-Methode ausgeschaltet
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = True
.CutCopyMode = False
End With

Set lshInfo = Nothing
Set lshData = Nothing

End Sub

AW: dein vermtl. gesuchter Code - in der Schleife eingepasst

24.11.2024 21:05:34

Tom

Hallo Udo,

vielen herzlichen Dank - perfekt!

PS: Wenn man richtig schreibt, was man will, bekommt man es auch :-)

Viele Grüße
TOM

AW: dein vermtl. gesuchter Code - in der Schleife eingepasst

26.11.2024 18:14:03

Udo D.

hi, so in etwa ;-)

ich hatte irgendwie das Bedürfnis mich daran zu versuchen, musste mich auch erst reinarb.
aber hat ja geklappt.

Viel Erfolg mit deiner Datei
Udo

Datenabgleich obere Linie weg

Forumthread: Datenabgleich obere Linie weg

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Datenabgleich obere Linie weg

Forumthread: Datenabgleich obere Linie weg

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread