19.08.2016, 11:52
20.08.2016, 08:07
Hallo Ralf,
nun habe ich doch noch etwas gefunden.
Die bedingte Formatierung in Spalte M (Kennzeichnung Gold, Silber, Bronze) habe ich über die gesamte Spalte laufen lassen.
Wie löst man das, adäquat zu Deinem letzten Vorschlag für die Zeile 2, in einer intelligenten Tabelle?
Viele Grüße
Bernd
nun habe ich doch noch etwas gefunden.
Die bedingte Formatierung in Spalte M (Kennzeichnung Gold, Silber, Bronze) habe ich über die gesamte Spalte laufen lassen.
Wie löst man das, adäquat zu Deinem letzten Vorschlag für die Zeile 2, in einer intelligenten Tabelle?
Viele Grüße
Bernd
20.08.2016, 08:27
(19.08.2016, 09:25)RPP63 schrieb: [ -> ]Du hast da ja eine ausgeblendete Hilfsspalte in der Tabelle, die ja nicht (mehr) benötigt wird.
Wenn Du sie löscht, ermittelst Du den (für Zeilen und auch Spalten dynamischen) Bereich E:"letzterWettkampf" folgendermaßen.
Sub RPP()
Dim Challenge As Range
With Tabelle1.Range("Tabelle1")
Set Challenge = Range(.Columns(5), .Columns(.Columns.Count - 2))
End With
Debug.Print Challenge.Address
End Sub
Hallo RPP63,
Ich habe mir Deinen Vorschlag angeschaut.
Auf die Hilfsspalte würde ich gern verzichten.
Leider verstehe ich Deinen Hinweis überhaupt nicht.
Ich bin noch nicht so weit in VB vorgedrungen.
Könntest Du mir bitte erklären, was ich nun tun soll?
Viele Grüße
Bernd
20.08.2016, 09:29
Hi Benrd,
Du schreibst analog zu den Formeln in die bedingte Formatierung bei "bezieht sich auf" rein: =$M$4:$M$35
Das verlängert sich dann auch mit jeder zugefügten Zeile der iT.
(20.08.2016, 08:07)Bödefeld schrieb: [ -> ]Die bedingte Formatierung in Spalte M (Kennzeichnung Gold, Silber, Bronze) habe ich über die gesamte Spalte laufen lassen.
Wie löst man das, adäquat zu Deinem letzten Vorschlag für die Zeile 2, in einer intelligenten Tabelle?
Du schreibst analog zu den Formeln in die bedingte Formatierung bei "bezieht sich auf" rein: =$M$4:$M$35
Das verlängert sich dann auch mit jeder zugefügten Zeile der iT.
20.08.2016, 10:36
Hallo Ralf,
Danke, das habe ich jetzt für alle bedingten Formatierungen so durchgezogen und es klappt sogar.
Übrigens, man kann die Formeln der Zeile 2 doch nach rechts ziehen.
Man muss dann nur noch die Spaltennamen ändern (und die Tabellen-Nummer, wenn man die Formel auf ein anderes Blatt überträgt).
Geht m.M.n. besser, als den Bereich jedes mal aufzuziehen.
Jetzt habe ich nur noch das Problem mit der Hilfsspalte und ("RPP63") Ralfs Antwort dazu.
Mal sehen, vielleicht klärt sich das auch noch dieses Wochenende.
Viel Spaß am Wochenende
Bernd
Danke, das habe ich jetzt für alle bedingten Formatierungen so durchgezogen und es klappt sogar.
Übrigens, man kann die Formeln der Zeile 2 doch nach rechts ziehen.
Man muss dann nur noch die Spaltennamen ändern (und die Tabellen-Nummer, wenn man die Formel auf ein anderes Blatt überträgt).
Geht m.M.n. besser, als den Bereich jedes mal aufzuziehen.
Jetzt habe ich nur noch das Problem mit der Hilfsspalte und ("RPP63") Ralfs Antwort dazu.
Mal sehen, vielleicht klärt sich das auch noch dieses Wochenende.
Viel Spaß am Wochenende
Bernd
20.08.2016, 12:07
So, ich hatte jetzt Zeit.
Aufbauend auf Fenneks Code folgt hier ein Ereignismakro, welches automatisch bei Neueinträgen in die Liste startet.
Das Makro gehört ins Klassnmodul der Tabelle.
Rechtsklick auf Tabellenreiter, Code anzeigen.
Datei im Anhang.
Gruß Ralf
Aufbauend auf Fenneks Code folgt hier ein Ereignismakro, welches automatisch bei Neueinträgen in die Liste startet.
Das Makro gehört ins Klassnmodul der Tabelle.
Rechtsklick auf Tabellenreiter, Code anzeigen.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Challenge As Range
Dim Anz&, j&, M&, Sp&
If Target.Count > 1 Then Exit Sub
With Me.Range("Tabelle1")
Set Challenge = Range(.Columns(5), .Columns(.Columns.Count - 2))
End With
If Not Intersect(Target, Challenge) Is Nothing Then
With Target
Anz = WorksheetFunction.Count(Challenge.Rows(.Row - 3))
If Anz > 4 Then
With Challenge.Rows(.Row - 3)
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlDiagonalDown).LineStyle = xlNone
End With
For j = 1 To Anz - 4
M = WorksheetFunction.Small(Challenge.Rows(.Row - 3), j)
Sp = WorksheetFunction.Match(M, Challenge.Rows(.Row - 3), 0)
With Cells(.Row, 4 + Sp)
.Borders(xlDiagonalUp).LineStyle = xlContinuous
.Borders(xlDiagonalDown).LineStyle = xlContinuous
.Borders(xlDiagonalDown).Color = -16776961
.Borders(xlDiagonalDown).Weight = xlMedium
End With
Next j
End If
End With
End If
End Sub
Datei im Anhang.
Gruß Ralf
20.08.2016, 13:02
Hallo Ralf (der andere),
Vielen Dank für Deine Hilfe.
Dein Script hat aber leider doch noch einen bug.
Wenn Du sortierst (z.B. nach "Rang"-Spalte "M") , werden die alten Kreuze nicht gelöscht und es kommt zu einen Kompilierfehler bei weiteren Eingaben.
Ich habe mal Dein Script in unseren aktuellen Arbeitsstand der Tabelle eingearbeitet und dann sortiert.
Du siehst das Problem in "ErgebnislisteRPP.xlsm" im Anhang.
Anbei auch meinem aktuellen Stand ("Ergebnisliste aktuell.xlsm").
Hier habe ich den Fehler mit den Kreuzen, der bei Dir noch auftritt, bereits beseitigt.
Zusätzlich dazu habe ich die durchkreuzten Felder noch mit einer hellgelben Füllung versehen.
An meiner Version gibt es aber noch 2 Probleme zu lösen:
PS.: "meine" Version bedeutet natürlich, die Version, die durch Mithilfe des Forums entstanden ist!
Grüße
Bernd
Vielen Dank für Deine Hilfe.
Dein Script hat aber leider doch noch einen bug.
Wenn Du sortierst (z.B. nach "Rang"-Spalte "M") , werden die alten Kreuze nicht gelöscht und es kommt zu einen Kompilierfehler bei weiteren Eingaben.
Ich habe mal Dein Script in unseren aktuellen Arbeitsstand der Tabelle eingearbeitet und dann sortiert.
Du siehst das Problem in "ErgebnislisteRPP.xlsm" im Anhang.
Anbei auch meinem aktuellen Stand ("Ergebnisliste aktuell.xlsm").
Hier habe ich den Fehler mit den Kreuzen, der bei Dir noch auftritt, bereits beseitigt.
Zusätzlich dazu habe ich die durchkreuzten Felder noch mit einer hellgelben Füllung versehen.
An meiner Version gibt es aber noch 2 Probleme zu lösen:
- Die Hilfsspalte sollte wegrationalisiert werden
- Nach jedem Sortieren werden die Kreuze erst gelöscht, wenn eine neue Eingabe in die Ergebnisfelder erfolgt ist.
Das ist unschön.
Die Ausführung des Makros "nur_4" habe ich im Objekt "Workbook" mit der Procedur "SheetChange" vereinbart, Das Makro "nur_4" selbst als Modul.
Hier liegt wohl der Fehler, weiß aber nicht wie.
PS.: "meine" Version bedeutet natürlich, die Version, die durch Mithilfe des Forums entstanden ist!
Grüße
Bernd
27.08.2016, 08:26
Hallo Ralf "RPP63"
kannst Du Dir bitte noch einmal Dein letztes Ereignismakro anschauen.
Da sind noch zwei Fehler drin:
Könntest Du das bitte noch ausbessern?
Du würdest mir damit wirklich einen großen Gefallen tun.
Viele Grüße und ein schönes Wochenende
Bernd
[/list]
kannst Du Dir bitte noch einmal Dein letztes Ereignismakro anschauen.
Da sind noch zwei Fehler drin:
- Beim Sortieren werden die Kreuze nicht mit verschoben und
- die Teilnehmer mit 0 Punkten sollten alle auf den letzten Platz gesetzt werden (im Beispiel Platz 25)
Könntest Du das bitte noch ausbessern?
Du würdest mir damit wirklich einen großen Gefallen tun.
Viele Grüße und ein schönes Wochenende
Bernd
[/list]
09.09.2016, 08:44
Hallo,
leider kann mir RPP63 anscheinend nicht mehr helfen.
deshalb das Problem noch einmal an alle hier im Forum:
Das Programm erfasst Sportergebnisse, wobei nur die 4 besten Ergebnisse addiert und die schlechten gestrichen werden.
Hier das Script von Ralf RPP34:
Das Script hat leider noch zwei kleine Fehler.(Die Tabelle mit den beiden kleinen Schönheitsfehlern dazu hier im Anhang):
Bitte, kann mir hier jemand aus der Patsche helfen?
Viele Grüße
Bernd
leider kann mir RPP63 anscheinend nicht mehr helfen.
deshalb das Problem noch einmal an alle hier im Forum:
Das Programm erfasst Sportergebnisse, wobei nur die 4 besten Ergebnisse addiert und die schlechten gestrichen werden.
Hier das Script von Ralf RPP34:
- Private Sub Worksheet_Change(ByVal Target As Range)
Dim Challenge As Range
Dim Anz&, j&, M&, Sp&
If Target.Count > 1 Then Exit Sub
With Me.Range("Tabelle1")
Set Challenge = Range(.Columns(5), .Columns(.Columns.Count - 2))
End With
If Not Intersect(Target, Challenge) Is Nothing Then
With Target
Anz = WorksheetFunction.Count(Challenge.Rows(.Row - 3))
If Anz > 4 Then
With Challenge.Rows(.Row - 3)
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlDiagonalDown).LineStyle = xlNone
End With
For j = 1 To Anz - 4
M = WorksheetFunction.Small(Challenge.Rows(.Row - 3), j)
Sp = WorksheetFunction.Match(M, Challenge.Rows(.Row - 3), 0)
With Cells(.Row, 4 + Sp)
.Borders(xlDiagonalUp).LineStyle = xlContinuous
.Borders(xlDiagonalDown).LineStyle = xlContinuous
.Borders(xlDiagonalDown).Color = -16776961
.Borders(xlDiagonalDown).Weight = xlMedium
End With
Next j
End If
End With
End If
End Sub
Das Script hat leider noch zwei kleine Fehler.(Die Tabelle mit den beiden kleinen Schönheitsfehlern dazu hier im Anhang):
- Beim Sortieren der Tabelle werden die Kreuze nicht an die neuen Positionen verschoben und
- Die Sportler ohne Einzelergebnisse sollen zusammen auf den letzten Platz gesetzt werden.
(In der Beispieldatei wäre es für die letzten 6 Teilnehmer Platz 26.)
Bitte, kann mir hier jemand aus der Patsche helfen?
Viele Grüße
Bernd
10.09.2016, 07:47
Hallo Bernd,
würde es auch reichen, die Zellen einzufärben statt der "Kreuze"? Die Farben werden nämlich mit sortiert.
Ansonsten müsste man nach dem Sortieren alle Zeilen prüfen und die Kreuze neu setzen.
würde es auch reichen, die Zellen einzufärben statt der "Kreuze"? Die Farben werden nämlich mit sortiert.
Ansonsten müsste man nach dem Sortieren alle Zeilen prüfen und die Kreuze neu setzen.