Bitte um Hilfe bei Änderung unserer Wettkampftabelle

[Bödefeld]

Hallo André,

entschuldige bitte erst einmal, dass ich mich erst heute zurückmelde, aber ich musste für mehrere Wochen ins Klinikum einziehen...

Habe Deinen Vorschlag in die Tabelle eingebaut (und Columns.Count auf 4 gesetzt, da ja noch eine Spalte dazu gekommen ist).
Das funktioniert jetzt eigentlich so, wie es sollte.
Gäbe es nun noch die Möglichkeit, auf die Hilfsspalte G&L zu verzichten, dann wäre sie optimal.
Die Auswertung wird bei uns von Leuten durchgeführt, die von EDV nichts verstehen.
Wenn die trotz ausgeblendeter Spalte Mist bauen, dann phhh.

Also, Danke für die Hilfe und wenn Du noch ne Möglichkeit siehst, auf die Spalte G&L zu verzichten, dann würde Dir unser Dank ewig hinterherlaufen. :19:

Viele Grüße
Bernd

PS.: habe die fertige Tabelle für Dich und alle, die es interessiert, in der letzten Fassung hochgeladen.

[schauan]

Hallo Bernd,

ich würde für das Blatt erst mal den Blattschutz setzen und nur die Zellen wo was eingegeben werden muss freigeben. Das schützt auf jeden Fall erst mal vor versehentlichen Änderungen, und der betreffenden Spalte sollte auch nichts mehr passieren können. Ansonsten müsste man versuchen, die ganzen Berechnungen mit VBA nach zu programmieren. Wenn sich dann mal was ändern sollte, muss man vielleicht wieder in den Code schauen, ob da auch was zu machen wäre ...

[Bödefeld]

Oh mann, das ging aber schnell mit Deiner Antwort.

Also, wenns nicht geht, dann muss ich halt sehen, dass die Leute damit zurechtkommen.
Im Notfall muss ich eben meinen Kopf hinhalten.
(Du glaubst gar nicht, wie schnell es immer Proteste gegen Wertungen gibt)

Mir ist aber noch ne kleine Schönheitssache aufgefallen.
Unter der Tabelle steht doch die Legende dazu, also "keine Wertung" usw.
Gibt es die Möglichkeit, dass sich diese Legende automatisch eine Zeile nach unten schiebt, wenn man unten an der Tabelle eine neuen Teilnehmer aufnimmt, sodass immer eine Leerzeile zwischen Tabelle und Legende bleibt?
Meine Leute haben schon wieder gejammert, dass sie nicht wissen, wie man Zeilen einfügt oder verschiebt.
Könntest Du hier bitte auch noch einmal helfen?

Nochmals Danke!
Bernd

[schauan]

Hallöchen,

tausche m Tabellenblatt Das Change-Makro aus:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell
With Range("Tabelle4")
  If Not Intersect(Target, Range(.Columns(5), .Columns(Columns.Count - 4))) Is Nothing Then
    Call crossFormat(Range("Tabelle4"))
  End If
  Set myCell = Cells(.Row + .Rows.Count, 1)
  If myCell.Value <> "" Then
    Rows(myCell.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
  End If
End With
End Sub

[Rabe]

Hi Bernd,

Gibt es die Möglichkeit, dass sich diese Legende automatisch eine Zeile nach unten schiebt, wenn man unten an der Tabelle eine neuen Teilnehmer aufnimmt, sodass immer eine Leerzeile zwischen Tabelle und Legende bleibt?
Meine Leute haben schon wieder gejammert, dass sie nicht wissen, wie man Zeilen einfügt oder verschiebt.
Könntest Du hier bitte auch noch einmal helfen?

wenn Du in der Spalte N der letzten Zeile bist, wird durch Druck auf "TAB" eine neue Zeile angehängt und die Legende um 1 nach unten verschoben.

Nach meinem Gerechtigkeitsempfinden sollte es so sein:
Bei gleichem Gesamt und gleichem letzten Jahres-Wettkampf sollten die mit weniger Wettkämpfen für das selbe End-Ergebnis einen Platz besser sein.

[Bödefeld]

Hallo André,
Konnte mich leider nicht eher um das Problem kümmern und Dir antworten.
Danke für die Idee, aber ich habe gerade festgestellt, dass bei der Anlage einer neuen Zeile die Berechnung der Rangfolge versagt, da sofort in das betreffende G&L-Feld ein unbestimmter Wert eingetragen wird (#Wert!).
Das bleibt so, bis dazu ein erstes Ergebnis kommt.
Manche steigen aber erst zum 2. Wettkampf ein...
Wie kann man das umgehen?

Rabe schrieb: "Nach meinem Gerechtigkeitsempfinden sollte es so sein:
Bei gleichem Gesamt und gleichem letzten Jahres-Wettkampf sollten die mit weniger Wettkämpfen für das selbe End-Ergebnis einen Platz besser sein."
Es stimmt schon, "Rabe", aber die Regeln sind eben so.
Wir haben sie von früher her übernommen und wollen daran erst einmal nichts ändern.


Bernd

[schauan]

Hallo Bernd,
ändere die Formel so:

=WENNFEHLER([@[Ges.]]*1000+[@[14.10.]];"")

[Bödefeld]

Hallo André,
na, so klappt das nach der Änderung. :18:
Danke nochmals für Deine Hilfe, jetzt kann das neue Wettkampfjahr beginnen.

Ich habe noch ein paar Probleme mit der "Vervielfältigung" des Tabellenblattes innerhalb der Arbeitsmappe
(jeweils eine Tabelle auf einem Tabellenblatt).
Da wir in verschiedenen Klassen starten, brauche ich die Tabelle auf mehreren Blättern.
Ich habe durch Probieren herausgefunden, dass ich im Editor für das neue Tabellenblatt jeweils ein Worksheet und ein Modul neu anlegen, dann
den Code vom alten kopieren und dann noch Namen (crossformatX, TabelleX)anpassen muss.
Gibt es denn noch eine einfachere Lösung, Tabellenblätter zu vervielfältigen, ohne jedes Mal in die VB-Programmierung einzugreifen
(sodass es jemand ohne VB-Kenntnisse tun kann)?

Die fertige Tabelle (Test3) habe ich hier noch einmal angehangen.
Vielleicht braucht sie jemand.

Gerade eben hat sich herausgestellt, dass es mit der Tabellenblatt-Kopie so doch nicht klappt.
Ich habe die Datei (Test4) mit zwei Seiten auch noch angehangen.
Im kopierten Blatt (2018) kommt es trotz Umbenennung zu Laufzeitfehlern und das Streichen der schlechtesten Ergebnisse klappt nun auch nicht mehr.
Bitte hilf mir auch hier noch einmal.

Viele Grüße
Bernd

[Bödefeld]

Hallo Andre

ich habe noch eine Bitte zur Wettkampftabelle.
Von anderen Vereinen bin ich gefragt worden, ob sie diese Tabelle auch verwenden könnten.
Es gibt da nur ein Problem mit den Streichergebnissen.
In unserer Tabelle werden die drei schlechtesten von sieben Ergebnisse gestrichen.
Die Ergebnisse befinden sich in den Spalten E bis K ab der Zeile 4

Nun soll ich das z.B. für eine Tabelle abwandeln, wo es nur drei Ergebnisse gibt, wobei das schlechteste gestrichen wird.
Hier befinden sich die Ergebnisse in den Spalten D bis F ab Zeile 5

Kannst Du mir bitte sagen, wo und was ich im Script ändern muss.
Hier noch einmal den Script:

Code:

[b]Worksheet:[/b]
Private Sub Worksheet_Calculate()
   Call crossFormat(Range("Tabelle3"))
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
With Range("Tabelle3")
 If Not Intersect(Target, Range(.Columns(5), .Columns(Columns.Count - 2))) Is Nothing Then
   Call crossFormat(Range("Tabelle3"))
 End If
End With
End Sub

[b]Modul:[/b]
Sub crossFormat(rngBereich As Range)
'Variablendeklarationen
'Bereiche zum Markieren
Dim rngZeilen As Range, Challenge As Range
'Integer
Dim Anz%, j%, M%, Sp%
 'Schleife ueber alle Zeilen des uebergebenen Bereiches
 For Each rngZeilen In rngBereich.Rows
   'mit einer Zeile
   With rngZeilen
     'Bereich Challange setzen (Bereich zum Markieren)
     Set Challenge = Range(rngZeilen.Columns(5), rngZeilen.Columns(rngZeilen.Columns.Count - 2))
     'Anzahl Eintraege im Bereich zaehlen
     Anz = WorksheetFunction.Count(Challenge)
     'mit dem Bereich Challange (Bereich zum Markieren)
     With Challenge
        'Markierung nd Farbe zuruecksetzen
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Interior.ColorIndex = xlNone
     'Ende mit dem Bereich Challange (Bereich zum Markieren)
     End With
     'Zaehler fuer Rang der kleinten Werte initialisieren
     Sp = 1
     'Schleife solange mehr als 4 Eintraege zu pruefen sind
     Do While Anz > 4
       'mit dem Bereich Challange (Bereich zum Markieren)
        With Challenge
          'kleinsten bzw. naechsten kleinsten Wert zuweisen
          M = WorksheetFunction.Small(Challenge, Sp)
          'Schleife ueber alle Spalten der zu pruefenden Zeile
          For j = 1 To .Columns.Count
            'mit der zu pruefenden Zelle
            With .Cells(1, j)
              'Wenn der Zellwert dem kleinsten entspricht und
              'die Zelle noch nicht gefaerbt ist, dann
              If .Value = M And .Interior.ColorIndex <> 19 Then
                'Raender und Farbe setzen
                .Borders(xlDiagonalUp).LineStyle = xlContinuous
                .Borders(xlDiagonalDown).LineStyle = xlContinuous
                .Borders(xlDiagonalDown).Color = -16776961
                .Borders(xlDiagonalDown).Weight = xlHairline
                .Interior.ColorIndex = 19
                'Anzahl der zu pruefenden Werte um 1 verringern
                Anz = Anz - 1
                'Wenn die Anzahl < 5 ist, Schleife verlassen
                If Anz < 5 Then Exit For
              'Ende Wenn der Zellwert dem kleinsten entspricht und ...
              End If
            'Ende mit der zu pruefenden Zelle
            End With
          'Ende Schleife ueber alle Spalten der zu pruefenden Zeile
          Next j
       'Ende mit dem Bereich Challange (Bereich zum Markieren)
        End With
      Sp = Sp + 1
     'Ende Schleife solange mehr als 4 Eintraege zu pruefen sind
      Loop
   'Ende mit einer Zeile
    End With
 'Ende Schleife ueber alle Zellen des uebergebenen Bereiches
 Next
End Sub

Es wäre nett, wenn Du mir hier noch einmal helfen könntest.

Viele Grüße
Bernd

[WillWissen]

Hi Bernd,

für längere Makros solltest du Codetags benutzen; sie sind dann besser lesbar. Benutze dazu bitte in der 2. Iconreihe den 5. Button von rechts.

[
Bild bitte so als Datei hochladen: Klick mich!
]