Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1884to1888
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Formatierung Ergebnisbereich

Formatierung Ergebnisbereich
01.06.2022 18:37:01
Peter
Folgende Aufgabe:
Ich frage Daten von einem MS_SQL-Server mit Power Query ab und lade diese Daten in eine Tabelle innerhalb eines Arbeitsblattes. Bei den Daten handelt es sich um eine Baugruppen-Strukturstückliste. Die Datenübergabe funktioniert zuverlässig. Die optische Aufbereitung der Daten ist sehr spartanisch. Als Lösung bot sich an, den Ergebnisbereich mit VBA optisch etwas aufzupeppen. Zellhintergrund entsprechend des Zeileninhaltes bunt eingefärbt, horizontale Ausrichtung definiert, Schriftfarbe definiert und Zahlenformat festgelegt.
Buttongesteuert aktualisiere ich zunächst die Abfragen und arbeite dann die Formatierung ab. Letztere wird zunächst sauber ausgeführt, abschließend aber (ausschließlich) die Zahlenformate wieder überschrieben. Die bunten Zeilen und die Zellausrichtung bleibt bestehen. Arbeitet man den Code im Debug-Mode ab, steht die Formatierung wie definiert inklusive der Zahlenformate. Arbeitet man den Code in Echtzeit ab, blitzt die gewünschte Formatierung zunächst kurz auf und wird dann überschrieben.
Was ich bereits abgearbeitet habe:
Alle Haken bei den externen Dateieigenschaften aller Aktualisierungs-Abfragen rausgenommen. Keine Änderung.
Alle Hintergrundabfragen deaktiviert. Keine Änderung.
Zwischen Abfrage und Formatierung eine satte Warteschleife eingebaut, damit die Formatierung definitiv erst dann startet, wenn die Abfrage beendet ist. Keine Änderung
Das Sub zur Formatierung solo gestartet. Formatierung erfolgt wir gewünscht. Ein Workaround wäre somit möglich.
Und ja, es wäre sinnvoll, die Datei hochzuladen. Da dann die Abfrage aber nicht läuft, macht das m.E. wenig Sinn. Wie kann man so etwas simulieren? Den Code des Moduls hänge ich an.
Die Kernfrage: Warum funktioniert das nicht in Kombination mit der Aktualisierungs-Abfrage?
Danke schon mal
Peter B

Option Explicit
Sub Modul_1_Hauptprogramm()
Sheets("Auftragskalkulation").Select
'Daten aktualisieren
Abfrage_aktualisieren 'Sub
' Plausibilitätsdaten, ob Auftrag aktuell
Sheets("Auftragskalkulation").Range("B2").Copy
Sheets("Auftragskalkulation").Range("E2").PasteSpecial xlPasteValues
'Plausibilitätsdaten, ob Position aktuell
Sheets("Auftragskalkulation").Range("B3").Copy
Sheets("Auftragskalkulation").Range("E3").PasteSpecial xlPasteValues
'Plausibilitätskontrolle, ob VErkaufspreis zu AMS übertragen ist
Sheets("Auftragskalkulation").Range("S12").Copy
Sheets("Auftragskalkulation").Range("E4").PasteSpecial xlPasteValues
Application.Wait 20000
'Tabelle Auftragskalkulation formatieren
Auftragskalkulation_Formatierung 'Sub
End Sub
Sub Abfrage_aktualisieren()
Dim SucheVerbindung As Long                 'Sucht Verbindungszeichenfolge
Dim Datenverbindung As WorkbookConnection   ' für einzelne Datenverbindungen
On Error Resume Next
'Gehe durch jede Datenverbindung und súche Verbindungszeichenfolge
For Each Datenverbindung In ThisWorkbook.Connections
SucheVerbindung = InStr(1, Datenverbindung.OLEDBConnection.Connection, "Provider=Microsoft.Mashup.OleDb.1", vbTextCompare)
'Sollte die Textkette nicht gefunden werden, erhält SucheVerbindung keinen Wert und es gibt einen Fehler
If Err.Number  0 Then
Err.Clear
Exit For
End If
'Wurde die Schleife bis hierher nicht abgebrochen und die Textkette gefunden, wird die Verbindung aktualisiert
If SucheVerbindung > 0 Then Datenverbindung.Refresh
Next Datenverbindung
End Sub
Sub Auftragskalkulation_Formatierung()
'Neuberechnung abschalten
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("Auftragskalkulation").Activate
'*** Formatierung Kopfzeile Ergebnisbereich
Range("BK_PDM_Auftragskalkulation[#Headers]").Select
With Selection.Font
.Name = "Calibri"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
'Autofilter abschalten
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
'Selection.AutoFilter
'Vorhandene Formatierung löschen
Range("BK_PDM_Auftragskalkulation").ClearFormats
'*** Spaltenformatierung Ergebnisbereich
'BDE-Nummer
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[BDE_NR]]").Select
Selection.ColumnWidth = 8
Selection.HorizontalAlignment = xlLeft
'Ebene
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Ebene]]").Select
Selection.ColumnWidth = 6.5
Selection.HorizontalAlignment = xlCenter
'Komponente
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Komponente]]").Select
Selection.EntireColumn.AutoFit
'Menge
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Menge]]").Select
Selection.ColumnWidth = 4.25
Selection.HorizontalAlignment = xlCenter
'Gesamtmenge
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Gesamtmenge]]").Select
Selection.ColumnWidth = 9
Selection.HorizontalAlignment = xlCenter
'Materialposition
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[MatPos]]").Select
Selection.ColumnWidth = 4.75
Selection.HorizontalAlignment = xlCenter
' PosArt schmäler
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[PosArt]]").Select
Selection.ColumnWidth = 6
Selection.HorizontalAlignment = xlCenter
'Dispoart schmäler
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Dispoart]]").Select
Selection.ColumnWidth = 5
Selection.HorizontalAlignment = xlCenter
'Artikel Spaltenbreite schmäler
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[MatArt]]").Select
Selection.ColumnWidth = 10
Selection.HorizontalAlignment = xlCenter
'Material-Einzelpreis
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Mat_Einzelpreis]]").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
Selection.ColumnWidth = 10
Selection.HorizontalAlignment = xlRight
'Material-Gesamtmenge
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Mat_Gesamtmenge]]").Select
Selection.NumberFormat = "#,##0.00_);[Red](#,##0.00)"
Selection.HorizontalAlignment = xlCenter
'FK_ST Fertigkennung Stückliste
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[FK_ST]]").Select
Selection.ColumnWidth = 5
Selection.HorizontalAlignment = xlCenter
'AgPos Arbeitsgangposition
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[AgPos]]").Select
Selection.ColumnWidth = 5
Selection.HorizontalAlignment = xlCenter
'Gesamtstunden Spaltenbreite schmäler wegen Positionsangaben
Range("BK_PDM_Auftragskalkulation[Gesamtstunden]").Select
Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
Selection.ColumnWidth = 10
'Stundensatz
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Stundensatz]]").Select
Selection.ColumnWidth = 7.5
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
'FK_AG Spaltenbreite schmäler wegen Fehlermeldungen
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[FK_AG]]").Select
Selection.ColumnWidth = 5
Selection.HorizontalAlignment = xlCenter
'Gesamtpreis AMS
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Gesamtpreis]]").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
'Zeilenpreis
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Zeilenpreis]]").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
'Zeilensummen
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Zeilensumme]]").Select
Selection.FormatConditions.Delete
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
'Selection.EntireColumn.AutoFit
'Symbol
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Symbol]]").Select
Selection.FormatConditions.Delete
'Selection.EntireColumn.AutoFit
Selection.HorizontalAlignment = xlCenter
'*** Farbliche Darstellung des Ergebnisbereichs der Strukturabfrage
Dim Anzahl_Spalten As Integer
Dim Anzahl_Zeilen As Integer
Dim Ergebnisbereich As Object
Dim z As Integer ' Laufvariable Zeilenbearbeitung
Dim s As Integer ' Laufvariable Spaltenbearbeitung
Range("BK_PDM_Auftragskalkulation[#All]").Select
Set Ergebnisbereich = Range("BK_PDM_Auftragskalkulation[#All]")
Anzahl_Spalten = Selection.Columns.Count
Anzahl_Zeilen = Selection.Rows.Count
'Zeilenweise Farbformatierung abhängig vom Zellinhalt der Spalte "SYMBOL" und "Ebene"
' für maximal 3 Ebenen
For z = 1 To Anzahl_Zeilen
Ergebnisbereich.Cells(z, 3).Select
Select Case True
Case Ergebnisbereich.Cells(z, 26).Value = "SYMBOL"
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Select
Selection.Interior.Color = RGB(244, 176, 132) ' Kopfzeile
Selection.Font.ColorIndex = 1
Next s
Case Ergebnisbereich.Cells(z, 26).Value = "K" And Ergebnisbereich.Cells(z, 2).Value = 1
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Interior.Color = RGB(38, 79, 169) ' Komponente Ebene 1
Ergebnisbereich.Cells(z, s).Font.ColorIndex = 2
Ergebnisbereich.Cells(z, s).Font.Bold = False
Next s
Case Ergebnisbereich.Cells(z, 26).Value = "K" And Ergebnisbereich.Cells(z, 2).Value = 2
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Interior.Color = RGB(49, 99, 212) ' Komponente Ebene 2
Ergebnisbereich.Cells(z, s).Font.ColorIndex = 2
Next s
Case Ergebnisbereich.Cells(z, 26).Value = "K" And Ergebnisbereich.Cells(z, 2).Value = 3
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Interior.Color = RGB(56, 115, 255) ' Komponente Ebene 3
Ergebnisbereich.Cells(z, s).Font.ColorIndex = 2
Next s
Case Ergebnisbereich.Cells(z, 26).Value = "K" And Ergebnisbereich.Cells(z, 2).Value = 4
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Interior.Color = RGB(88, 149, 255) ' Komponente Ebene 4
Ergebnisbereich.Cells(z, s).Font.ColorIndex = 1
Next s
Case Ergebnisbereich.Cells(z, 26).Value = "K" And Ergebnisbereich.Cells(z, 2).Value = 5
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Interior.Color = RGB(131, 177, 255) ' Komponente Ebene 5
Ergebnisbereich.Cells(z, s).Font.ColorIndex = 1
Next s
Case Ergebnisbereich.Cells(z, 26).Value = "K" And Ergebnisbereich.Cells(z, 2).Value = 6
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Interior.Color = RGB(177, 205, 255) ' Komponente Ebene 6
Ergebnisbereich.Cells(z, s).Font.ColorIndex = 1
Next s
Case Ergebnisbereich.Cells(z, 26).Value = "m"
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Interior.ColorIndex = 15 'Material
Ergebnisbereich.Cells(z, s).Font.ColorIndex = 1
Next s
Case Ergebnisbereich.Cells(z, 26).Value = "a"
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Select
Selection.Interior.ColorIndex = 2 'Arbeitsgang
Selection.Font.ColorIndex = 1
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.14996795556505
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.14996795556505
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Next s
End Select
Next z
'*** Zellenformatierung Kopfbereich
' Summe Gesamtpreis AMS
Range("Q10").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
' Gemeinkostenzuschlag AMS
Range("Q11").Select
Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
' Verkaufspreis AMS
Range("Q12").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
' Summe Gesamtpreis AMSCalc
Range("Y10").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
' Gemeinkostenzuschlag AMSCalc
Range("Y11").Select
Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
' Verkaufspreis AMSCalc
Range("Y12").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
'*** Neuberechnung einschalten
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Call Calculate
End Sub

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Formatierung Ergebnisbereich
01.06.2022 19:07:31
Luschi
Hallo Peter,
bei solchen Aktualisierungsaktionen sollte / nein muß man neben
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
unbedingt
Application.EnableEvents = False ' abschalten denn bei Deinen vielen .Select tritt das
Worksheet_SelectionChange - Ereignis ein und keiner von weiß was darin alles definiert ist.
Außerdem arbeite ich mit Haltepunkten (F9-Taste), um an bestimmten Vba-Code-Zeilen den Debugger zu veranlassen anzuhalten um dann im Überwachungsfenster sich Inhalte von Objektvariablen (mit denen Du ja kaum arbeitest) und anderen Variablen anzusehen.
Dieses Debuggen im Vba-Code kann sehr viel Zeit beanspruchen, macht aber Vieles klarer, den Vba-Code zu verstehen - ohne Beispieldatei ist das aber für die Helfer ein Tappen im Dunkeln.
Gruß von Luschi
aus klein-Paris
PS: diese .Select - Befehlen müssen einfach weg, dafür aber mit Objektvariablen arbeiten und den Zeilen-/Spaltenversatz nutzen:

    Dim rg As Range
Set rg = Range("Q10")
With rg
' Summe Gesamtpreis AMS
.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
' Gemeinkostenzuschlag AMS - Q11
.Offset(1, 0).NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
' Verkaufspreis AMS - Q12
.Offset(2, 0).NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
End With

Anzeige
AW: Formatierung Ergebnisbereich
02.06.2022 10:51:20
Peter
Hallo Luschi,
ich habe den Code auf Verarbeitung mit Objekten geändert. Ich habe zunächst nicht verstanden, wie ich die Spalten ansprechen kann, schlussendlich aber funktioniert es. Den Offsetsprung auf die Spalten anzuwenden, ist mir nicht geglückt. Es geht immer eleganter, aber mein erster Versuch läuft. (siehe Beispiel)

'Zeilenweise Farbformatierung abhängig vom Zellinhalt der Spalte "SYMBOL" und "Ebene"
' für maximal 3 Ebenen
For z = 1 To Anzahl_Zeilen
Select Case True
Case Ergebnisbereich.Cells(z, 26).Value = "SYMBOL"
With Ergebnisbereich.Rows(z)
.Interior.Color = RGB(244, 176, 132) ' Kopfzeile
.Font.ColorIndex = 1
.Font.Size = 10
End With
Case Ergebnisbereich.Cells(z, 26).Value = "K" And Ergebnisbereich.Cells(z, 2).Value = 1
With Ergebnisbereich.Rows(z)
.Interior.Color = RGB(38, 79, 169) ' Komponente Ebene 1
.Font.ColorIndex = 2
.Font.Bold = False
.Font.Size = 12
End With
Alle Selects sind jetzt Geschichte. Trotzdem habe ich Application.EnableEvents noch mit dazugepackt.
Bisheriges Fazit:
Die gesamte Formatierung läuft jetzt wesentlich schneller (Geschwindigkeit geschätzt dreimal so schnell) und ich habe was dazugelernt. Meinen Dank dafür.
Das Kernproblem - die nicht funktionierende Währungsformatierung - ist dadurch jedoch nicht gelöst. Ein Fehler ist mir noch aufgefallen: Einige String-Felder hatten führende Leerzeichen. Das hat einen Einfluss auf das funktionieren der Formatierung, warum auch immer. Eigentlich sind Leerzeichen keine "Elemente einer niederen Klasse", sondern einfach nur gemäß Regel zu verarbeiten.
Warum die Formatierung nicht läuft, ist mir nicht klar. Ich werde mal versuchen, das Abfrageergebnis vom Server in eine weiteres Sheet zu verfrachten, das als Datenquelle dienen kann um die Abfrage serverunabhängig zu machen. Dann stelle ich die Datei ein.
Ansonsten bin ich für jeden Hinweis dankbar.
Danke erstmal
Peter B
Anzeige
AW: Formatierung Ergebnisbereich
03.06.2022 21:52:30
Yal
Hallo Peter,
deine gesamte Prozedure "Abfrage_aktualisieren" könnte mit der Zeile
ActiveWorkbook.RefreshAll
ersetzt werden.
Code, der isch wiederholt, kann man eine Prozedure ablegen. Mit:

Sub Formatiere(Adresse As String, Optional ColWd As Single = -1, Optional HorizAlig As Long = -1, Optional Numfrmt As String = "")
With Range(Adresse)
If Not ColWd = -1 Then .ColumnWidth = ColWd
If Not HorizAlig = -1 Then .HorizontalAlignment = HorizAlig
If Not Numfrmt = "" Then .Numberformat = Numfrmt
End With
End Sub
wird in der abrufenden "Auftragskalkulation_Formatierung" aus

    Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[BDE_NR]]").Select
Selection.ColumnWidth = 8
Selection.HorizontalAlignment = xlLeft
nur noch

Formatiere "BK_PDM_AUFTRAGSKALKULATION[[#All],[BDE_NR]]", 8, xlLeft
VG
Yal
Anzeige
AW: Formatierung Ergebnisbereich
10.06.2022 16:26:29
Peter
Danke Yal.
Ich habe die Code-Diät verstanden. Schlank ist Klasse. Ich hab's mangels Zeit noch nicht einarbeiten können.
Mein Kernproblem besteht immer noch, die Formatierung im Kombination mit einer Aktualisierung der Abfrage. Nun habe ich aber eine Beispieldatei bauen können, die das Problem in einer vom SQL-Abruf unabhängigen Weise zeit. Siehe https://www.herber.de/bbs/user/153515.xlsm. Auffällig ist, das der Formataufbau nur bei numerischen Feldern und Datumsfelder nicht richtig funktioniert.
Drei Buttons zeigen das Problem:
Aktualisieren und Formatieren: Abfrage wird aktualisiert, die richtige Formatierung blitzt kurz auf und wird dann in eine unerwünschte korrigiert, warum auch immer :-(
Aktualisieren: Abfrage wird aktualisiert, läuft wie gewünscht
Formatieren; Formatiert wie gewünscht.
Klickt man nacheinander die Buttons Aktualisieren und Formatieren an, steht abschließend die Formatierung wie gewünscht. Läßt man beides sequentiell als Code laufen, klappt es nicht.
Grüße
Peter B
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige