Makroveränderung Folgethread

Hallo zusammen,
ich habe hier schon sehr viel Hilfe durch Erich G. bekommen und nur so konnte ich mein Excelprojekt fast fertig stellen nun plagen mich noch 2 kleinere Probleme.
Dies ist eine Fortstezung des Threads: https://www.herber.de/forum/archiv/1012to1016/t1013703.htm
Dort habe ich mit einem Makro folgende Hilfe bekommen:


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim intA As Long, intS As Long, wksS As Worksheet, wksT As Worksheet
Dim zz As Long, rngH As Range, intT As Long
Dim ii As Long, jj As Long, rngK As Range
If Not Intersect(Target, Range("A2:A21,A28")) Is Nothing Then
intA = Application.CountA(Range("A2:A21"))      ' Anz. Spieler
intS = Application.Min(intA, 14)                ' Anz. Spieler-Anzeige
intT = Cells(28, 1)                             ' Anz. Spieltage
Set wksS = Sheets("Torschützen Spielt.")
Set wksT = Sheets("Spieltagausw.")
With Sheets("Torschützen gesamt")
If intA = 0 Then
.Rows("1:50").Hidden = True                  ' incl. Diagramm?
wksS.Columns(1).Resize(, 41).Hidden = True
Else                 ' einblenden intA Spieler (Zeilen 3 bis 3+intA-1)
.Rows(1).Resize(2 + intA).Hidden = False ' ab Zeile 1 wg. Überschriften
.Rows("23:50").Hidden = False                ' Diagramm
wksS.Columns(1).Resize(, 2 * intA + 1).Hidden = False
wksS.Rows(1).Resize(intT + 3).Hidden = False
' ausblenden 20-intA Spieler (Zeilen 3+intA bis 22)
If intA          If intS * intT = 0 Then ' alles ausblenden
wksT.Rows("1:684").Hidden = True
Else                    ' einblenden intS Spieler (Zeilen 3 bis 3+intS-1)
Set rngH = wksT.Rows(1).Resize(intS + 2) ' blende Zeilen 1,2,3,4 ein
Set rngH = Union(rngH, wksT.Rows(17).Resize(2)) ' blende Zeile 17 und 18 ein
If intS 
End Sub

Mit dem fetten Teil habe ich nun ein Problem, leider hat sich nun im finalen Test herausgestellt, das man sich nicht immer auf IntS beziehen kann, sondern für eine korrekte Anzeige folgendes gemacht werden müßte. Leider bekomme ich es aber selbst nicht hin.
Wenn im (Tabelenblatt 1 Zelle AV 18) = 0
dann blende Zeilen 1:18 aus
sonst blende Zeilen 1 bis (Tabelenblatt 1 Zelle AV 18 + 2) ein
sowie Zeilen 17,18 ein
und wenn Zelle (Tabelenblatt 1 Zelle AV 18) dann blende von (Tabelenblatt 1 Zelle AV 18) +3, 14 - (Tabelenblatt 1 Zelle AV 18) Zeilen aus
Wenn im (Tabelenblatt 2 Zelle AV 18) = 0
dann blende Zeilen 19:36 aus
sonst blende Zeilen 19 bis (Tabelenblatt 2 Zelle AV 18 + 20) ein
sowie Zeilen 35,36 ein
und wenn Zelle (Tabelenblatt 2 Zelle AV 18) dann blende von (Tabelenblatt 2 Zelle AV 18) +21, 14 - (Tabelenblatt 2 Zelle AV 18) Zeilen aus
...................
Wenn im (Tabelenblatt 38 Zelle AV 18) = 0
dann blende Zeilen 667:684 aus
sonst blende Zeilen 667 bis (Tabelenblatt 38 Zelle AV 18 + 668) ein
sowie Zeilen 683,684 ein
und wenn Zelle (Tabelenblatt 38 Zelle AV 18) dann blende von (Tabelenblatt 38 Zelle AV 18) +669, 14 - (Tabelenblatt 38 Zelle AV 18) Zeilen aus
und wenn IntT Dann blende Zeilen (intT * 18 + 1), Zeile 684 aus
Ich würde mich freuen wenn ihr mir dabei nochmal helfen könntet! Habe das Forum hier sehr zu schätzen gelernt.
Gruß Kai

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim intA As Long, intS As Long, wksS As Worksheet, wksT As Worksheet Dim zz As Long, rngH As Range, intT As Long Dim ii As Long, jj As Long, rngK As Range Dim lngAV18 As Long If Not Intersect(Target, Range("A2:A21,A28")) Is Nothing Then intA = Application.CountA(Range("A2:A21")) ' Anz. Spieler intS = Application.Min(intA, 14) ' Anz. Spieler-Anzeige intT = Cells(28, 1) ' Anz. Spieltage Set wksS = Sheets("Torschützen Spielt.") Set wksT = Sheets("Spieltagausw.") With Sheets("Torschützen gesamt") If intA = 0 Then .Rows("1:50").Hidden = True ' incl. Diagramm? wksS.Columns(1).Resize(, 41).Hidden = True Else ' einblenden intA Spieler (Zeilen 3 bis 3+intA-1) .Rows(1).Resize(2 + intA).Hidden = False ' ab Zeile 1 wg. Überschriften .Rows("23:50").Hidden = False ' Diagramm wksS.Columns(1).Resize(, 2 * intA + 1).Hidden = False wksS.Rows(1).Resize(intT + 3).Hidden = False ' ausblenden 20-intA Spieler (Zeilen 3+intA bis 22) If intA

With wksT Application.ScreenUpdating = False 'Bildschirm nicht aktualisieren .Range(.Rows(1), .Rows(684)).Hidden = False 'Alle Zeilen einblenden Set rngH = Nothing For ii = 1 To intT 'Blätter 1 bis 38 abarbeiten und auszublendende Zeilen merken lngAV18 = Val(Worksheets(Format(ii, "0")).Range("AV18").Value) 'lngAV18 = _ Tabellenblatt Zelle AV18 If lngAV18 = 0 Then 'Wenn lngAV18 = 0 dann If rngH Is Nothing Then 'Wenn rngH Nothing dann Set rngH = .Range(.Rows(1 + (ii - 1) * 18), .Rows(18 + (ii - 1) * 18)) ' _ rngh = Range(Zeile19, Zeile 36) Else 'Sonst Set rngH = Union(rngH, .Range(.Rows(1 + (ii - 1) * 18), .Rows(18 + (ii - 1) _ * 18))) 'rngh = Range(Zeile19, Zeile 36) End If Else 'Sonst .Range(.Rows(1 + (ii - 1) * 18), .Rows(lngAV18 + 2 + (ii - 1) * 18)).Visible = _ True 'Range(Reihe19, Reihe(lngAV18 + 20) sichtbar .Range(.Rows(17 + (ii - 1) * 18), .Rows(18 + (ii - 1) * 18)).Visible = True ' _ Range(Reihe35, Reihe36) sichtbar If lngAV18

With wksT Application.ScreenUpdating = False 'Bildschirm nicht aktualisieren .Range(.Rows(1), .Rows(684)).Hidden = False 'Alle Zeilen einblenden Set rngh = Nothing For ii = 1 To intT 'Blätter 1 bis 38 abarbeiten und auszublendende Zeilen merken 'lngAV18 = Tabellenblatt Zelle AV18 lngAV18 = Val(Worksheets(Format(ii, "0")).Range("AV18").Value) If lngAV18 = 0 Then 'Wenn lngAV18 = 0 dann If rngh Is Nothing Then 'Wenn rngH Nothing dann 'ii=1 --> rngh = Range(Zeile1 bis Zeile 18) 'ii=2 --> rngh = Range(Zeile19 bis Zeile 36) Set rngh = .Range(.Rows(1 + (ii - 1) * 18), .Rows(18 + (ii - 1) * 18)) Else 'Sonst 'ii=1 --> rngh = rngh + Range(Zeile1 bis Zeile 18) 'ii=2 --> rngh = rngh + Range(Zeile19 bis Zeile 36) ' usw. Set rngh = Union(rngh, .Range(.Rows(1 + (ii - 1) * 18), _ .Rows(18 + (ii - 1) * 18))) End If Else 'Sonst ' ii=1 --> Range(Reihe 1, Reihe(lngAV18 + 0) sichtbar ' ii=2 --> Range(Reihe 19, Reihe(lngAV18 + 20) sichtbar 'Die nachfolgende Zeile ist nicht erforderlich, die Zeilen sind schon sichtbar ##### .Range(.Rows(1 + (ii - 1) * 18), .Rows(lngAV18 + 2 + (ii - 1) * 18)).Visible = True ' ii=1 --> Range(Reihe 17, Reihe 18) sichtbar ' ii=2 --> Range(Reihe 35, Reihe36) sichtbar ' usw. 'Die nachfolgende Zeile ist nicht erforderlich, die Zeilen sind schon sichtbar ##### .Range(.Rows(17 + (ii - 1) * 18), .Rows(18 + (ii - 1) * 18)).Visible = True If lngAV18 Setze rngh Bereich Reihe lngAV18 + 3 bis Reihe 18 - 0 'ii=2 -->Setze rngh Bereich Reihe lngAV18 + 21 bis Reihe 36 - 0 'usw Set rngh = .Range(.Rows(lngAV18 + 3 + (ii - 1) * 18), _ .Rows(18 + (ii - 1) * 18) - 0) '##### die 0 muss du ggf. anpassen Else 'Sonst 'ii=1 -->Setze rngh= rngh + Bereich Reihe lngAV18 + 3 bis Reihe 18 - 0 'ii=2 -->Setze rngh= rngh + Bereich Reihe lngAV18 + 21 bis Reihe 36 - 0 'usw Set rngh = Union(rngh, .Range(.Rows(lngAV18 + 3 + (ii - 1) * 18), _ .Rows(18 + (ii - 1) * 18) - 0)) '##### die 0 muss du ggf. anpassen End If End If End If Next 'Zeilen ausblenden 'Wenn rngH ist nicht Nothing, dann rngh.Reihe nicht Hidden If Not rngh Is Nothing Then rngh.EntireRow.Hidden = False If intT

With wksT Application.ScreenUpdating = False 'Bildschirm nicht aktualisieren .Range(.Rows(1), .Rows(684)).Hidden = False 'Alle Zeilen einblenden Set rngH = Nothing For ii = 1 To intT 'Blätter 1 bis 38 abarbeiten und auszublendende Zeilen merken lngAV17 = Val(Worksheets(Format(ii, "0")).Range("AV17").Value) 'lngAV17 = _ Tabellenblatt Zelle AV17 If lngAV17 = 0 Then 'Wenn lngAV17 = 0 dann If rngH Is Nothing Then 'Wenn rngH Nothing dann Set rngH = .Range(.Rows(1 + (ii - 1) * 18), .Rows(18 + (ii - 1) * 18)) ' _ rngh = Range(Zeile19, Zeile 36) Else 'Sonst Set rngH = Union(rngH, .Range(.Rows(1 + (ii - 1) * 18), .Rows(18 + (ii - 1) _ * 18))) 'rngh = Range(Zeile19, Zeile 36) End If Else 'Sonst .Range(.Rows(1 + (ii - 1) * 18), .Rows(lngAV17 + 2 + (ii - 1) * 18)).Hidden = _ False 'Range(Reihe19, Reihe(lngAV17 + 20) sichtbar .Range(.Rows(17 + (ii - 1) * 18), .Rows(18 + (ii - 1) * 18)).Hidden = False ' _ Range(Reihe35, Reihe36) sichtbar If lngAV17

Private Sub Worksheet_Change(ByVal Target As Range) Worksheets("Torschützen gesamt").Unprotect Password:="123" Dim intA As Long, intS As Long, wksS As Worksheet, wksT As Worksheet Dim zz As Long, rngH As Range, intT As Long Dim ii As Long, jj As Long, rngK As Range Dim lngAV17 As Long If Not Intersect(Target, Range("A2:A21,A28")) Is Nothing Then intA = Application.CountA(Range("A2:A21")) ' Anz. Spieler intS = Application.Min(intA, 14) ' Anz. Spieler-Anzeige intT = Cells(28, 1) ' Anz. Spieltage Set wksS = Sheets("Torschützen Spielt.") Set wksT = Sheets("Spieltagausw.") With Sheets("Torschützen gesamt") If intA = 0 Then .Rows("1:50").Hidden = True ' incl. Diagramm? wksS.Columns(1).Resize(, 41).Hidden = True Else ' einblenden intA Spieler (Zeilen 3 bis 3+intA-1) .Rows(1).Resize(2 + intA).Hidden = False ' ab Zeile 1 wg. Überschriften .Rows("23:50").Hidden = False ' Diagramm wksS.Columns(1).Resize(, 2 * intA + 1).Hidden = False wksS.Rows(1).Resize(intT + 3).Hidden = False ' ausblenden 20-intA Spieler (Zeilen 3+intA bis 22) If intA

Sub Worksheet_Change(ByVal Target As Range) Dim intA As Long, intS As Long, wksS As Worksheet, wksT As Worksheet Dim zz As Long, rngH As Range, intT As Long Dim ii As Long, jj As Long, rngK As Range Dim lngAV17 As Long, lngAV19 If Not Intersect(Target, Range("A2:A21,A28")) Is Nothing Then intA = Application.CountA(Range("A2:A21")) ' Anz. Spieler intS = Application.Min(intA, 14) ' Anz. Spieler-Anzeige intT = Cells(28, 1) ' Anz. Spieltage Set wksS = Sheets("Torschützen Spielt.") Set wksT = Sheets("Spieltagausw.") With Sheets("Torschützen gesamt") If intA = 0 Then .Rows("1:50").Hidden = True ' incl. Diagramm? wksS.Columns(1).Resize(, 41).Hidden = True Else ' einblenden intA Spieler (Zeilen 3 bis 3+intA-1) .Rows(1).Resize(2 + intA).Hidden = False ' ab Zeile 1 wg. Überschriften .Rows("23:50").Hidden = False ' Diagramm wksS.Columns(1).Resize(, 2 * intA + 1).Hidden = False wksS.Rows(1).Resize(intT + 3).Hidden = False ' ausblenden 20-intA Spieler (Zeilen 3+intA bis 22) If intA ' ----------------------------------------------------- ab hier nach Spieltag If Not Intersect(Target, Range("A28")) Is Nothing Then For zz = 1 To intT Sheets(CStr(zz)).Visible = True ' Blätter einblenden Next zz For zz = intT + 1 To 38 Sheets(CStr(zz)).Visible = False Next zz If 0 = 1 Then With Sheets("Torschützen Spielt.") If intA = 0 Then .Rows("1:43").Hidden = True Else .Rows("1:" & intA).Hidden = False If intA

Sub TestProzedur() Dim intA As Long, intS As Long, wksS As Worksheet, wksT As Worksheet Dim rngH As Range, intT As Long Dim ii As Long, jj As Long, rngK As Range Dim lngAV17 As Long, lngAV19 intA = Application.CountA(Range("A2:A21")) ' Anz. Spieler intS = Application.Min(intA, 14) ' Anz. Spieler-Anzeige intT = Cells(28, 1) ' Anz. Spieltage Set wksS = Sheets("Torschützen Spielt.") Set wksT = Sheets("Spieltagausw.") With Sheets("Torschützen gesamt") If intA = 0 Then .Rows("1:50").Hidden = True ' incl. Diagramm? wksS.Columns(1).Resize(, 41).Hidden = True Else ' einblenden intA Spieler (Zeilen 3 bis 3+intA-1) .Rows(1).Resize(2 + intA).Hidden = False ' ab Zeile 1 wg. Überschriften .Rows("23:50").Hidden = False ' Diagramm wksS.Columns(1).Resize(, 2 * intA + 1).Hidden = False wksS.Rows(1).Resize(intT + 3).Hidden = False ' ausblenden 20-intA Spieler (Zeilen 3+intA bis 22) If intA

Private Sub Berechnung_Click() Application.ScreenUpdating = False Call TeamAusdruck Call GÜUAusdruck Call Gegnerische_Teamauswertung Call TestProzedur Application.ScreenUpdating = True Sheets("Datenerfassung").Select End Sub

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makroveränderung Folgethread

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread