25.09.2016, 10:45 (Dieser Beitrag wurde zuletzt bearbeitet: 25.09.2016, 10:47 von Bödefeld.)
Hallo,
ich habe ein Makro bei der Eingabe eines Wertes aufgezeichnet, der gleich gestrichen wird:
Sub Makro1() ' ' Makro1 Makro ' Kreuze '
' Range("J6").Select ActiveCell.FormulaR1C1 = "113" Range("J7").Select End Sub
Der Vorschlag mit nur einem Strich ist auch nicht der Bringer. Ich habe eine Pdf-Datei angehangen, worin Du siehst, wie breit der Strich ist.
Welche letzte Version meinst Du? Im Code selbst wird "Tabelle1" als Parameter direkt aufgerufen. Wenn ich den Code für beide Tabellen nutzen wollte, müsste der Parameter doch übergeben werden? (Sorry, meine Stärke von ganz früher her ist der Microassembler und Turbopascal)
Ich glaub Dir ja auch ohne pdf, dass Deine Striche dick sind. Ich hoffe, Du glaubst mir auch ohne Bild meine dünnen
Der Tabellenname wird schon als Parameter übergeben. Schaue mal in die codes der beiden Tabellenblätter, was wie aufgerufen wird, und dann in das Modul1. Die Makroaufzeichnung musst Du mal in einer leeren Tabelle machen. Bei Dir fehlt genau der Teil mit den Borders, der die Striche setzt - siehe mein Beitrag.
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
Hallo, ich bin wahrscheinlich schwer von Begriff, denn ich weiß nicht, was ich aufzeichnen soll. Ich habe aus lauter Verzweiflung mal ein Kreuz in ein Feld gesetzt:
Dass die Strichstärke bei Dir stimmt, habe ich wirklich nicht angezweifelt. Ich wollte Dir nur zeigen, WIE stark die Striche sind. Bitte nicht böse sein.
Das Script habe ich mir angeschaut, aber ich schaue da wie das Schwein ins Uhrwerk... Ich verstehe einfach nicht, was Du meinst. Im Modul1 steht:
With rngZeilen With Range("Tabelle1") Set Challenge = Range(.Columns(5), .Columns(.Columns.Count - 2)) End With
Im Modul1 wird doch die Tabelle1 als Parameter direkt aufgerufen. Damit klappt das ja nicht mehr in der Tabelle2. Oder bin ich hier total auf dem Holzweg?
Den Fehler des Nicht-Streichens findest Du wahrscheinlich doch nicht so schnell. Die Listen vom gestrigen Wettkampf, die ich herausschicken musste, habe ich deshalb mit der Hand "geschönt".
25.09.2016, 18:59 (Dieser Beitrag wurde zuletzt bearbeitet: 25.09.2016, 18:59 von schauan.)
Hallo Bernd, Mit der letzten Datei meinte ich die von heute früh 6:33. Aufzeichnen sollst du nur wie du händisch die Kreuze erzeugst. Da sollte dann was ähnliches raus kommen wie ich gekostet hab mit Wright...
Geponstet und Weight Sch.... Android
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
den Anhang habe ich nicht gesehen, habe wahrscheinlich am Wochenende zu viel gearbeitet... Das Kreuz (zwei Striche) habe ich genau so in einer neuen Tabelle erzeugt und aufgezeichnet. Den Code habe ich Dir schon gestern 18:27 gesendet: Da habe ich nur die Kreuze extra noch anders eingefärbt und umpositioniert.
Hier der Code für nur zwei Striche in ein Feld:
Sub Kreuze() ' ' Kreuze Makro ' ' ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 65.25, 15, 133.5, 28.5). _ Select ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 66.75, 13.5, 132, 29.25). _ Select End Sub
Ich habe diese Tabelle mal gedruckt. Und siehe - die Striche sind im Druck genau so dünn, wie in der Tabelle.
ist schon verrückt, was Excel da wie aufzeichnet ... Bei mir sieht das so aus - siehe unten. Zuvor hab ich aber noch was gefunden, eventuell hilft das. Nimm mal im crossFormat-Makro statt xlThin dann xlHairLine, die soll nochmal dünner sein. Auf dem Schirm seh ich bei mir allerdings keinen Unterschied
So, hier mal meine Aufzeichnung aus 2016, über Zelle Formatieren - Rahmen - diagonale Linien, keine Umstellung von Eigenschaften (dünn ist Standard).
Sub Makro1() '
Code:
' Makro1 Makro '
' With Selection.Borders(xlDiagonalDown) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlDiagonalUp) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin End With Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone End Sub
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
mit xlHairLine funktioniert es auch im Druck. Das Problem wäre gelöst.
Jedoch hat sich in Deine Tabelle v. 25.09.2016, 06:33 ein weiterer schlimmer Fehler eingeschlichen. Schau mal bitte in die Zeilen 5 oder 10. Da stehen 5 statt 4 nicht gestrichenen Werten und 2 gestrichene. Aber es sollen alle Werte, außer den 4 besten gestrichen werden. Der Fehler passiert so: Wenn ich z.B. in J5 einen niedrigeren Wert (1-113), als die zuvor stehenden Werte eintrage, wird ein Wert zu wenig gestrichen. Trage ich dort eine 114 ein, wird ein Wert zu viel gestrichen.
Die Gesamtpunktzahl in der Spalte L wird richtig berechnet.
In der Anlage siehst Du, was ich meine.
Bei dieser Version v. 25.09.2016, 06:33 von Dir ist mir auch aufgefallen, dass es beim Öffnen der Tabelle und Aktivierung zur Bearbeitung nach dem Download aus dem Forum 2x zum Laufzeitfehler 1004 kommt: "Die Methode 'Range' für das Objekt '_Global' ist fehlgeschlagen. Das tritt komischer Weise nach dem lokalen Speichern und erneutem Öffnen der Tabelle nicht mehr auf.
das mit dem Streichen war dann wohl falsch aufgefasst. Ich schrieb ja "hier werden nun alle kleinsten Werte durchkreuzt." Also die kleinsten im Sinne von "wenn der kleinste Wert mehrfach auftritt, dann alle diese kleinsten mit dem Wert" Ich war mir da ja nicht ganz sicher, siehe hier: http://www.clever-excel-forum.de/thread-...l#pid53490
Da muss ich mir nun mal Gedanken machen. Aber kannst trotzdem vorher noch schreiben, welche durchgestrichen werden sollen, wenn z.B. alle Werte gleich sind - siehe die Frage in der verlinkten Antwort.
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
hier wäre nun das korrigierte Makro. Ich hab noch reichlich Kommentare eingefügt. Sollte jetzt funktionieren.
Code:
Sub crossFormat1(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 'Edne 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
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
- siehe mein Beitrag.