Tabelle generieren

[lapunta]

Hallo,

ich habe hier folgenden Code, der mir über drei Variablen (AnzD,AnzP,AnzA) eine Tabelle generiert:

Code:

Public ZLo, SLo, ZRu, SRu As Integer
Public farbnummer As Integer

Sub TabConfig03()

Dim Spaltenname As String
Dim i, j, k As Integer
Dim EdTab02 As Range

Range(Cells(12, 27), Cells(30, 36)).Name = "EdTab02" ' Tabellenbereich ohne Rand
maxrow = Range("EdTab02").Rows.Count
maxcol = Range("EdTab02").Columns.Count

With Range(Cells(10, 26), Cells(30, 37))
   .Clear
   .Interior.ColorIndex = 55
End With

For j = 1 To maxrow
   With Range("EdTab02")
       .Range(Cells(j, 1), Cells(j, 2)).MergeCells = True 'Spalten AA:AB
       .Range(Cells(j, 4), Cells(j, 5)).MergeCells = True 'Spalten AD:AF
       .Range(Cells(j, 7), Cells(j, 9)).MergeCells = True 'Spalten AD:AF
   End With
Next j

AnzD = 5
AnzP = 0
AnzA = 4
sumDPA = AnzD + AnzP + AnzA + 3 ' "+3" = Überschriftenzeilen

Cells(2, 30) = sumDPA

For j = 1 To maxcol ' ----------------------------------------------Spaltenzähler
   For i = 1 To sumDPA '--------------------------------Zeilenzähler
   
       If AnzP = 0 And i = 2 + AnzD Then i = i + 1
       
       Select Case i
           Case 1, 2 + AnzD, 3 + AnzD + AnzP
               farbnummer = 12 'dunkelblau
               Spaltenname = ""
           Case Else
               Select Case j
                   Case 2
                       farbnummer = 5 'hellblau
                       l = l + 1
                       Spaltenname = "Column " & Chr(64 + l)
                   Case Else
                       farbnummer = 56 'weiß
                       Spaltenname = ""
               End Select
        End Select
           
           Range("EdTab02").Cells(i, j).Select
           Call Zelleanzeigen
           Range("EdTab02").Cells(i, j - 1) = Spaltenname
   Next
Next
End Sub

Private Sub Zelleanzeigen()

   With Selection
       .Interior.ColorIndex = farbnummer
       .Borders(xlEdgeLeft).LineStyle = xlContinuous
       .Borders(xlEdgeTop).LineStyle = xlContinuous
       .Borders(xlEdgeBottom).LineStyle = xlContinuous
       .Borders(xlEdgeRight).LineStyle = xlContinuous
   End With
End Sub

Das Ganze funktioniert auch prächtig, falls AnzP größer 0 ist.

Ergebnis:
   

Ein Problem tritt auf, wenn AnzP = 0 ist, dann habe ich natürlich zwei Zeilen Überschrift:
ohne if Abfrage!

   

Mit der If-Abfrage ist es mir lediglich gelungen, daß die erste Überschriftenzeile nicht eingefärbt wird.

   

Frage: Wie kriege ich die leere Zeile zwischen den beiden Bereichen weg?

[Elex]

Hallo

Bei       AnzD = 0     AnzP = 1      AnzA = 1      hast du doch auch zwei Überschriften.

Vorschlag  AnzD, AnzP, AnzA nacheinander Abfragen und Auswerten.

AnzD = 0 nichts tun      >0 Tabelle
AnzP = 0 nichts tun      >0 Tabelle
AnzA = 0 nichts tun      >0 Tabelle
 

Mfg

[Elex]

Hier mal ein fertiges Bsp.


  Tab erzeugen.xlsm (Größe: 23,08 KB / Downloads: 2)