141 Aufrufe
Gefragt in Tabellenkalkulation von addeguddi Experte (2.6k Punkte)
Ein nettes Hallo an das Forum,

suche eine Lösung in VBA, da ich keine Ahnung in diesem Bereich habe, habe ich es trotzdem einmal versucht etwas zusammen zu stellen. Bis auf einen Teil funktioniert es. In Zelle B1 = Anzahl Spieler diese Zahl wird durch rechtem Mausklick verändert und in den Zellen E1 bis L1 werden Namen aufgelistet, je nach Zahl die in Zelle B1 steht, werden bestimmte Spalten ausgeblendet.

Beispiel:

In B1 steht 3 dann Werden die Spalten von H bis L ausgeblendet da es nur 3 Spieler sind  usw. jetzt mein Problem. Wenn ich auf B1 klicke und aus der 3 wird die 4 sollte die Spalte H eingeblendet werden und das schaffe ich nicht.

Vielleicht kann mir jemand das fehlende Teil in das VBA einpflegen.

Das ist das VBA

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

ActiveSheet.Unprotect

If Not Intersect(Target, Range("B1")) Is Nothing Then

        Cancel = True

        Range("B1") = Range("B1").Value + 1

End If

ActiveSheet.Protect

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$B$1" Then

' Nimm den Wert des geänderten Bereiches

Select Case Target.Value

' Vergleiche mit ZAHL, nicht String

Case 3

Range("h:l").EntireColumn.Hidden = True

Case 4

Range("i:l").EntireColumn.Hidden = True

Case 5

Range("j:l").EntireColumn.Hidden = True

Case 6

Range("k:l").EntireColumn.Hidden = True

Case 7

Range("l:l").EntireColumn.Hidden = True

Case 8

Range("l:l").EntireColumn.Hidden = True

Case 2

' Blende Spalten g:O aus

Columns("e:o").EntireColumn.Hidden = True

Range("e:o").EntireColumn.Hidden = False

End Select

' Setze den Cursor zurück auf "B1"

Target.Select

End If

End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

ActiveSheet.Unprotect

If Not Intersect(Target, Range("B1")) Is Nothing Then

        Cancel = True

        Range("B1") = 2

End If

End Sub

Gruß Adde

3 Antworten

+1 Punkt
Beantwortet von
ausgewählt von mickey
 
Beste Antwort

Guten Morgen

sollte sich einfach lösen lassen

Du musst einfach immer alle Spalten angeben (auch die die eingeblendet werden sollen)

hab das mal ergänzt wie ich es mir denke (wobei 7 und 8 sind gleich ?)

Case 3

Range("h:l").EntireColumn.Hidden = True

Case 4

Range("h:h").EntireColumn.Hidden = False
Range("i:l").EntireColumn.Hidden = True

Case 5

Range("h:i").EntireColumn.Hidden = False
Range("j:l").EntireColumn.Hidden = True

Case 6

Range("h:j").EntireColumn.Hidden = False
Range("k:l").EntireColumn.Hidden = True

Case 7
 

Range("h:k").EntireColumn.Hidden = False
Range("l:l").EntireColumn.Hidden = True

Case 8

Range("h:k").EntireColumn.Hidden = False
Range("l:l").EntireColumn.Hidden = True

0 Punkte
Beantwortet von addeguddi Experte (2.6k Punkte)
Guten morgen,

habe die Lösung erstellt. Hier ist die Lösung:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$1" Then
' Nimm den Wert des geänderten Bereiches
Select Case Target.Value
Case 3
Range("h:L").EntireColumn.Hidden = True
Case 4
Range("e:h").EntireColumn.Hidden = False
Case 5
Range("E:I").EntireColumn.Hidden = False
Case 6
Range("E:J").EntireColumn.Hidden = False
Case 7
Range("E:K").EntireColumn.Hidden = False
Case 8
Range("E:L").EntireColumn.Hidden = False

Case 2
' Blende Spalten g:O aus
Columns("E:L").EntireColumn.Hidden = True
Range("E:L").EntireColumn.Hidden = False
End Select
' Setze den Cursor zurück auf "B1"
Target.Select
End If
End Sub

Gruß Adde
0 Punkte
Beantwortet von addeguddi Experte (2.6k Punkte)
Hallo Anonym,

danke für deine Mühe. habe es ausprobiert und es Funktioniert auch. Wie du lesen konntest habe ich auch eine Lösung erstellt.

Gruß Adde
...