Rahmen in einer Pivottabelle in Abhängigkeit eines Zellwertes setzen

Computer: Software & Programmierung Office Software
#1

Hallo zusammen,

ich habe mal wieder ein Problem und habe auch weder hier noch in verschiedenen Internetforen eine Lösung gefunden.

Ich habe eine Pivottabelle, bei der in der ersten Spalte eine Zahl steht und darunter leere Zellen in unterschiedlicher Anzahl. Ich möchte nun immer um die Zelle mit der Zahl und den darunter stehenden leeren Zellen samt den dazugehörigen Spalten, 17 Stück an der Zahl,  einen Rahmen setzen. Leider gibt es keine diesbezügliche Formatvorlagen oder Layoutvorlagen in Excel. Ich arbeite mit Ecxel 2007 und kann den Rahmen auch nicht über eine bedingte Formatierung setzen, wegen der leeren Zellen. Aber es gehören immer die Zelle mit Zahl samt den leeren Zellen darunter zusammen und dies soll durch den Rahmen gekennzeichnet werden.

Ich hoffe, ich habe mich verständlich ausgedrückt und Ihr könnt mir helfen. Vielen Dank schon einmal im voraus.

#2

Hallo Datenhexe,

ich denke, das kann man über VBA lösen. Was aber noch zu klären wäre:
Wieviele Leerzellen unter dem letzten Eintrag sollen denn mit eingerahmt werden?

Gruß, Andreas

#3

Hallo Andreas,

ja, da gebe ich Dir recht. Es ist wahrscheinlich nur über VBA zu lösen.

Leider variiert die Anzahl der Leerzellen unter dem letzten Eintrag. Es müssen also immer die Leerzellen unter dem letzten Eintrag ausgelesen werden und dann muss ein Rahmen gesetzt werden. Leider weiß ich nicht, wie ich die Anzahl der Leerzellen per VBA auslesen kann. Vielleicht kannst Du mir ja dabei helfen. Ich wäre Dir sehr dankbar dafür.

LG Martina

#4

Hallo Andreas,

Hi Martina,

Leider variiert die Anzahl der Leerzellen unter dem letzten
Eintrag. Es müssen also immer die Leerzellen unter dem letzten
Eintrag ausgelesen werden

Ja, aber wie denn? Wenn alles unter dem letzten Eintrag bis zum Ende des Tabelleblattes leer ist, dann geht das je nach Excelversion bis Zeile 1048576. Natürlich kann man das so machen und einen Rahmen bis ganz unten machen, aber ich glaube das meinst du nicht so. Also: Was ist das Kriterium für die letzte leere Zelle? Sind evtl. in anderen Spalten noch gefüllte Zellen, und der Rahmen soll bis zur letzten gefüllte Zelle in diesen anderen Spalten gehen?

werden. Leider weiß ich nicht, wie ich die Anzahl der
Leerzellen per VBA auslesen kann. Vielleicht kannst Du mir ja
dabei helfen. Ich wäre Dir sehr dankbar dafür.

Wenn du mir das Kriterium für die letzte „leere“ Zelle verrätst, kriegen wir das leicht hn.

LG Martina

Gruß, Andreas

#5

Hallo Andreas,

nein unter dem letzte Eintrag ist nicht alles leer. Die Tabelle ist so aufgebaut, In Spalte A steht eine Nummer und in den nächsten Spalten, 20 an der Zahl, stehen die dazugehörigen Informationen. Pro Information eine Zeile. In diesen Zeilen steht in Spalte A keine Nummer. Wenn eine neue Nummer in A steht, dann stehen in den dazugehörigen 20 Spalten wieder die Informationen. Da es zu jeder Nummer in A eine unterschiedliche Anzahl an Informationen gibt, variiert die Anzahl der Leerzellen in Spalte A. Der Rahmen soll um die Nummer in A und die dazugehörigen Informationen in den restlichen Spalten gezogen werden. Ich hoffe, ich habe mich verständlich ausgedrückt. Wenn Du es garnicht verstehen kannst, würde ich eine Beispieldatei hochladen.

VG Martina

#6

'Nabend Martina,

probier’s mal mit dem Code hier:

Option Explicit

Sub rahmen()
 Dim z1 As Long, z2 As Long, letzte As Long

 letzte = Cells(Rows.Count, 2).End(xlUp).Row
 z1 = 1
 Do
 z2 = WorksheetFunction.Min(Cells(z1, 1).End(xlDown).Row - 1, letzte)
 With Range(Cells(z1, 1), Cells(z2, 21))
 With .Borders(xlEdgeLeft)
 .LineStyle = xlContinuous
 .ColorIndex = xlAutomatic
 .TintAndShade = 0
 .Weight = xlThick
 End With
 With .Borders(xlEdgeTop)
 .LineStyle = xlContinuous
 .ColorIndex = xlAutomatic
 .TintAndShade = 0
 .Weight = xlThick
 End With
 With .Borders(xlEdgeBottom)
 .LineStyle = xlContinuous
 .ColorIndex = xlAutomatic
 .TintAndShade = 0
 .Weight = xlThick
 End With
 With .Borders(xlEdgeRight)
 .LineStyle = xlContinuous
 .ColorIndex = xlAutomatic
 .TintAndShade = 0
 .Weight = xlThick
 End With
 End With
 z1 = z2 + 1
 Loop Until z2 = letzte
End Sub

Füge ihn in den Codebereich des Tabellenblattes ein und lass ihn laufen.

Gruß, Andreas

#7

Hallo Andreas,

vielen vielen Dank. Es funktioniert super. Könntest Du mir bitte noch die Kommentare dazu schreiben, damit ich weiß, was was macht.

Vielen Dank.

VG Martina

#8

Voilà, mit Kommentaren

Option Explicit

Sub rahmen()
 Dim z1 As Long ' ist die Zeile des Bereichsanfangs
 Dim z2 As Long ' ist die Zeile des Bereichsendes
 Dim letzte As Long ' Ist die allerletzte belegte Zeile in Spalte 2

 ' Die allerletzte belegte Zeile in Spalte 2 wird ermittelt:
 ' Rows.Count ist die maximal mögliche Zeilenzahl in einem Tabelleblatt
 ' Cells(Rows.Count, 2) ist die letztmögliche Zelle in Spalte 2
 ' End(xlUp) geht von dieser letztmöglichen Zelle (die hoffentlich leer ist)
 ' so weit nach oben, bis die erste gefüllte Zelle (von unten gesehen) gefunden wird
 ' (entspricht den Tasten Strg mit Pfeil nach oben).
 ' Row ist die Zeilennummer dieser Zelle
 ' Diese Zeilennummer wird in "letzte" abgelegt.
 letzte = Cells(Rows.Count, 2).End(xlUp).Row

 ' Die Zeile des ersten Bereichsanfags ist 1
 ' Hier sollte in Spalte A eine Zahl stehen.
 z1 = 1

 Do

 ' Cells(z1, 1) ist Zelle A1
 ' End(xlDown) geht von dort so weit nach unten,
 ' bsi die nächste gefüllte Zelle kommt
 ' Row ist deren Zeilennummer, Row - 1 ist also die Zeilennummer darüber
 ' (die letzte leere Zelle im ersten Bereich)
 ' Worksheetfunction.Min vergleicht diese Zeilennummer mit dem
 ' Wert in "letzte" und legt den kleineren der beiden in z2 ab.
 z2 = WorksheetFunction.Min(Cells(z1, 1).End(xlDown).Row - 1, letzte)

 ' Der Bereich, der eingerahmt werden soll geht von Spalte A in Zeile z1
 ' bis zu Spalte U in Zeile z2.
 With Range(Cells(z1, 1), Cells(z2, 21))

 ' Hier geht's um den linken Rand des Bereichs
 With .Borders(xlEdgeLeft)

 .LineStyle = xlContinuous ' Durchgezogene Linie
 .ColorIndex = xlAutomatic ' Farbe automatisch
 .TintAndShade = 0 ' Helligkeit neutral
 .Weight = xlThick ' Dicke Linie
 End With

 ' Dito für den oberen Rand
 With .Borders(xlEdgeTop)
 .LineStyle = xlContinuous
 .ColorIndex = xlAutomatic
 .TintAndShade = 0
 .Weight = xlThick
 End With

 ' Dito für den unten Rand
 With .Borders(xlEdgeBottom)
 .LineStyle = xlContinuous
 .ColorIndex = xlAutomatic
 .TintAndShade = 0
 .Weight = xlThick
 End With

 ' Dito für den rechten Rand
 With .Borders(xlEdgeRight)
 .LineStyle = xlContinuous
 .ColorIndex = xlAutomatic
 .TintAndShade = 0
 .Weight = xlThick
 End With
 End With

 ' Der nächste Bereichsanfang ist 1 Zeile unter dem letzten Bereichsende
 z1 = z2 + 1

 ' Wenn das Bereichsende gleich der letzten gefüllte Zelle in Spalte B ist, ist Schluss
 Loop Until z2 = letzte
End Sub

Gruß, Andreas

#9

Vielen vielen Dank für Deine Mühe. Das hilft mir alles super weiter.

VG Martina