Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
19.04.2024 17:05:40
Zählen von Zeilen, in denen in bestimmten Bereich Daten sind
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1552to1556
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1552to1556
1552to1556
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Starthilfe VBA Code

Starthilfe VBA Code
23.04.2017 13:18:13
Frank
Hallo zusammen,
ich möchte den Abschnitt in der Beispielmappe mittels VBA Code erstellen,das er dann genauso aussieht. Hab in meinen vielen Beispiel-Dateien auch den einen oder anderen Code,weiß ihn aber nicht recht einzusetzen. Deswegen hätte ich gerne ne Starthilfe.
Wenn, dann bitte nur die Einleitung und die ersten drei Zeilen,den Rest möchte ich selbst versuchen,sonst lerne ich es ja nie
https://www.herber.de/bbs/user/113054.xls
Lg Frank

21
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Starthilfe VBA Code
23.04.2017 13:30:03
Crazy
Hallo
die ersten drei Zeilen?
so?
Option Explicit
Sub irgendwas()
End Sub
MfG Tom
AW: Starthilfe VBA Code
23.04.2017 14:17:20
Frank
Hey Tom,
ich meinte natürlich die ersten drei Zeilen aus der Beispielmappe,also Zeilen 3,4 und 5 ;)
Gruß Frank
AW: Starthilfe VBA Code
23.04.2017 14:33:55
Hajo_Zi
Hallo Frank,
das ist nur eine Zeile, was möchtest Du dann noch machen, wenn wir den kompletten Code posten?
Sheets("Tabelle2").Copy After:=Sheets(1)

AW: Starthilfe VBA Code
23.04.2017 14:54:32
Frank
Hallo Hajo,
ich meinte nicht die Tabelle einfach kopieren,sondern wie ich die Zellen per VBA fülle,die Rahmen setze und eventuell die Spaltenbeiten festlege,deswegen ja auch die Beispielmappe.
An den Rest möchte ich mich dann selbst ran wagen,um mal das Verständnis zu bekommen.
Lg Frank
Anzeige
AW: Starthilfe VBA Code
23.04.2017 14:58:31
Hajo_Zi
Hallo Frank,
Columns("A:A").ColumnWidth = 10.71
Rows("1:1").RowHeight = 12.75
Rows("2:2").RowHeight = 13.5
Ich bin jetzt raus, da Problem gelöst.
Gruß Hajo
AW: Starthilfe VBA Code
23.04.2017 15:01:14
Hajo_Zi
Hallo Frank,
es fehlte die erste Zeile.
Sheets.Add
jetzt sind es sogar schon 4
Gruß Hajo
AW: Starthilfe VBA Code
23.04.2017 15:22:15
Frank
Hallo Hajo,
wie man ein Tabellenblatt hinzufügt bzw wie man es kopiert,das weiß ich schon ;-)
Mir geht es eher um sowas hier 

Sub Erstellen()
Dim Spa As Long, N As Integer
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
With .Range("F1:M9")
.ClearContents
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
.Font.Bold = True
End With
With .Cells(2, Spa + 1)
.MergeCells = False
For N = 7 To 10
With .Borders(N)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 10
End With
Next N
End With
With .Cells(2, Spa + 5)
For N = 7 To 10
With .Borders(N)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 45
End With
Next N
End With
With .Cells(8, Spa + 1)
For N = 7 To 10
With .Borders(N)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 3
End With
Next N
End With
With .Cells(8, Spa + 5)
For N = 7 To 10
With .Borders(N)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 5
End With
Next N
End With
Hier werden jetzt nur die Rahmen erzeugt,es fehlt jetzt noch die Füllfarbe und die Spaltenbreite.Natürlich in einer sinnvollen Anordnung,da mein Code garantiert wieder unnötigen Ballast beinhaltet.
Deswegen meine Bitte nach einem Beispielcode für die ersten 2 oder 3 Zeilen der Beispielmappe
Lg Frank
Anzeige
AW: Starthilfe VBA Code
23.04.2017 16:53:41
Crazy
Hallo
deine Aufgabe erinnert mich stark an meine erste VBA-Begegnung...
und die konnte ich hervorragend mit dem Makrorekorder lösen
und danach einfach den Code bearbeiten... sprich das ganze select und acivate eliminieren
MfG Tom
AW: Starthilfe VBA Code
23.04.2017 19:19:16
Frank
Hey Tom,
hab sowas ja schon öfters mal mit dem Macro-Recorder gemacht,aber bei euch sahen die Codes doch immer noch irgendwie anders aus.
Hab das jetzt mal so gemacht wie du gesagt hast 

Sub Makro1()
' Makro1 Makro
' Makro am 23.04.2017 von Frank aufgezeichnet
Cells.Select
With Selection.Interior
.ColorIndex = 1
.PatternColorIndex = xlAutomatic
End With
Range("P20").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 5
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Selection.ColumnWidth = 3.29
Range("Q20").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 46
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Selection.ColumnWidth = 10.71
Range("R20").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Selection.ColumnWidth = 2.29
Range("N21").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Selection.ColumnWidth = 2.29
Range("O21").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 44
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Range("S21").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Range("T21").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Selection.ColumnWidth = 2.29
Range("P22").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 5
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Range("Q22").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 46
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Range("R22").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End Sub
Was muss/kann denn jetzt noch bearbeitet werden? Ein paar Zeilen wie diese z.B. hab ich gelöscht,da dort eh = xlNone stand.Wobei ich nicht weiß,was ausgerechnet die beiden zu bedeuten haben.
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Lg Frank
Anzeige
AW: Starthilfe VBA Code
23.04.2017 20:07:30
Gerd
Hallo Frank,
nächster Schritt: Ersetze überall die Auswahl direkt durch das ausgewählte Rangeobjekt.
Sub vorher()
Cells.Select
With Selection.Interior
.ColorIndex = 1
.PatternColorIndex = xlAutomatic
End With
Range("P20").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
End Sub

Sub Nachher()
With Cells.Interior
.ColorIndex = 1
.PatternColorIndex = xlAutomatic
End With
With Range("P20").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
End Sub
Gruß Gerd
Anzeige
AW: Starthilfe VBA Code
23.04.2017 20:08:07
Crazy
Hallo
BorderAround gibbet wohl erst ab xl2013
so könnte dein Code bereinigt aussehen
Sub Makro1()
Cells.Interior.ColorIndex = 1
With Range("P20:R20, N21:O21, S21:T21, P22:R22")
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
End With
Range("P20").Interior.ColorIndex = 5
Range("Q20").Interior.ColorIndex = 46
Range("R20, N21, T21, R22").Interior.ColorIndex = 15
Range("O21").Interior.ColorIndex = 44
Range("S21").Interior.ColorIndex = 4
Range("P22").Interior.ColorIndex = 5
Columns(16).ColumnWidth = 3.29
Columns(17).ColumnWidth = 10.71
Columns(18).ColumnWidth = 2.29
Columns(14).ColumnWidth = 2.29
Columns(20).ColumnWidth = 2.29
End Sub
MfG Tom
Anzeige
AW: Starthilfe VBA Code
23.04.2017 21:58:38
Gerd
Hallo Tom,
ob es hilft, mehrere Schritte zu überspringen? BorderAround gibt es schon länger als Smartphones.
Sub Makro2()
Dim X As Integer
Cells.Interior.ColorIndex = 1
With Range("P20, Q20, R20, N21, O21, S21, T21, P22, Q22, R22")
For X = 7 To 10 'xlEdgeLeft=7,xlEdgeTop=8,xlEdgeBottom=9,xlEdgeRight=10
With .Borders(X)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
Next
End With
End Sub


  Sub Makro3()
Cells.Interior.ColorIndex = 1
Range("P20, Q20, R20, N21, O21, S21, T21, P22, Q22, R22").BorderAround _
LineStyle:=xlContinuous, Weight:=xlMedium, ColorIndex:=2
End Sub
Gruß Gerd
Anzeige
AW: Starthilfe VBA Code
23.04.2017 21:59:02
Gerd
Hallo Tom,
ob es hilft, mehrere Schritte zu überspringen? BorderAround gibt es schon länger als Smartphones.
Sub Makro2()
Dim X As Integer
Cells.Interior.ColorIndex = 1
With Range("P20, Q20, R20, N21, O21, S21, T21, P22, Q22, R22")
For X = 7 To 10 'xlEdgeLeft=7,xlEdgeTop=8,xlEdgeBottom=9,xlEdgeRight=10
With .Borders(X)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
Next
End With
End Sub


  Sub Makro3()
Cells.Interior.ColorIndex = 1
Range("P20, Q20, R20, N21, O21, S21, T21, P22, Q22, R22").BorderAround _
LineStyle:=xlContinuous, Weight:=xlMedium, ColorIndex:=2
End Sub
Gruß Gerd
Anzeige
AW: Starthilfe VBA Code
23.04.2017 22:18:12
Crazy
Hallo Gerd
zumindest bei xl2010 krieg ich BorderAround jetzt tatsächlich hin
hatte bei meinem Test vorher die Doppelpunkte vor den "="-Zeichen verschlampt *schäm*
MfG Tom
AW: Starthilfe VBA Code
23.04.2017 22:56:30
Frank
Hallo Gerd, hallo Tom,
so langsam raucht mir der Kopf bei so vielen Möglichkeiten. Werde das alles erstmal sacken lassen.
Eine letzte Frage für heute... gehen mehrere Spalten in eine Columns-Anweisung z.B Columns("108", "110", "112", "114").ColumnWidth = 2.29 oder muss das über ne Range Anweisung erfolgen?
Die doofe Hilfe und auch mein Buch gibt da keine Auskunft drüber
Lg Frank
AW: Starthilfe VBA Code
23.04.2017 23:33:13
Gerd
Hallo Frank! 
Union(Columns(108), Columns(110), Columns(112), Columns(114)).ColumnWidth = 2.29
Es gibt noch ein paar weitere Schreibweisen.
P.S.: BorderAround zeichnet der Makorekorder nicht auf u. weiter unten im Forum hast du noch eine Antwortung zum Button.
Gruß Gerd
Anzeige
AW: Starthilfe VBA Code
23.04.2017 14:52:33
Werner
Hallo Frank,
also da verstehe ich das Problem ehrlich gesagt jetzt nicht so ganz. Warum nimmst du das, was du hier hochgeladen hast nicht als Mustervorlage und blendest dieses Blatt aus. Anschließen per Makro die Mustervorlage als neues Blatt kopieren, das neue Blatt umbenennen und fertig.
https://www.herber.de/bbs/user/113058.xlsm
Gruß Werner
AW: Starthilfe VBA Code - Ich werd noch irre
24.04.2017 20:49:54
Frank
Hallo allerseits,
da freue ich mich mal,das etwas klappt und was kommt dann?
Code von Gerd: 

Range("DP2,DQ2,DR2,DN3,DO3,DS3,DT3,DK4,DP4,DQ4,DR4,DM5,DU5,DG6,DL6,DM6,DU6,DV6,DP7,DQ7,DR7,DJ8, _
DK8,DN8,DO8,DS8,DT8,DJ9,DK9:DL9,DP9,DQ9,DR9,DH10,DI10,DW10") _
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium, ColorIndex:=2  'Rahmen werden erstellt "Teil 1"
Frank´s Makro-Recorder: 

With Range("DN4,DJ4,DJ5,DJ6,DJ7,DL7,DH7,DH8,DH9,DN7")
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
End With
Soweit geht alles wunderbar. Nun wollte ich mal wieder besonders clever sein: 


Range("DN4,DJ4,DJ5,DJ6,DJ7,DL7,DH7,DH8,DH9,DN7").Borders(xlEdgeLeft) LineStyle _ 

=xlContinuous Weight = xlMedium ColorIndex = 2
Nichts war,ne Fehlermeldung kommt.
Bedeutet das,BorderAround geht,aber Border(xlEdgeLeft geht nicht? Egal ob mit oder ohne Klammern?
Lg Frank
Anzeige
AW: Rahmen entwirren
24.04.2017 21:19:59
Gerd
Hallo Frank,
was auch funktionieren sollte: 
With Range("DN4,DJ4,DJ5,DJ6,DJ7,DL7,DH7,DH8,DH9,DN7")
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeLeft).ColorIndex = 2
End With
Aber eine "Borders(xlEdge..)" hat eine andere Syntax als ein "Borderaround"
Gruß Gerd
AW: Rahmen entwirren
25.04.2017 03:28:56
Frank
Hallo Gerd,
habe mir jetzt mal die Syntax dazu durch gelesen und ein bissl probiert. 
With Range("DN4,DJ4,DJ5,DJ6,DJ7,DL7,DH7,DH8,DH9,DN7").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
'Syntax für .Borders(xlEdgeLeft),.Borders(xlEdgeRight) usw. geht nur über ein With-Anweisung

Sehe aber grad,dass du das in deinem vorher/nachher Beispiel ebenfalls so gemacht hast ;-)
Lg Frank
AW: Rahmen entwirren
25.04.2017 17:45:30
Frank
Hallo,
mit Hilfe von Gerd und Tom plus meiner vielen Teilstücke an Codes ist das für den Anfang dabei heraus gekommen. Leider hat sich noch ein kleiner Fehler eingeschlichen 
Sub BoardErstellen()  ' Mit Unterstützung von Gerd L und Crazy Tom
Dim i As Integer
With Sheets("Turnier-Board")
Cells.Interior.ColorIndex = 1  ' Hintergrund wird schwarz eingefärbt
Columns(120).ColumnWidth = 3.29
Union(Columns(108), Columns(110), Columns(112), Columns(114), Columns(116), Columns(118), _
Columns(122), Columns(124), Columns(126), Columns(128)).ColumnWidth = 2.29  ' _
Spaltenbreite wird zugewiesen
' " Die blauen Linien dienen in der Test und Lernphase quasi als Hilfslinien "
With Rows("10").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 5
End With
With Columns(112).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 5
End With
With Columns(126).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 5
End With
' " Voriger Teil wird nur 1x benötigt und braucht somit nicht mit in die Schleife "
' " Rahmen werden erstellt Bereich Zeile 2 - Zeile 10 "
Range("DL6:DM6").MergeCells = True ' ! Beim Kopieren des Bereichs DH2-DV10 bleibt die  _
Formatierung nicht erhalten !
Range("DP2,DQ2,DR2,DN3,DO3,DS3,DT3,DK4,DP4,DQ4,DR4,DM5,DU5,DG6,DL6,DM6,DU6,DV6,DP7,DQ7,DR7, _
DJ8,DK8,DN8,DO8,DS8,DT8,DJ9,DK9:DL9,DP9,DQ9,DR9,DH10,DI10,DW10") _
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium, ColorIndex:=2
' !!! Syntax für .Borders(xlEdgeLeft),.Borders(xlEdgeRight)usw. geht nur über ein With- _
Anweisung !!!
With Range("DN4,DJ4:DJ7,DL7,DW7:DW9,DN7").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Range("DJ4").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Range("DT4,DT7,DG7:DG9").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
' " Die Zellen werden mit den entsprechenden Farben gefüllt "
Range("DP2, DP4, DP7, DP9").Interior.ColorIndex = 5  'Blau
Range("DQ2, DQ4, DQ7, DQ9").Interior.ColorIndex = 46  'Orange
Range("DR2, DN3, DT3, DR4, DV6, DR7, DJ8, DN8, DT8, DJ9, DR9, DH10").Interior.ColorIndex =  _
15  'Hellgrau
Range("DS3, DU6, DS8").Interior.ColorIndex = 4  'Grün
Range("DU5, DK9, DL9").Interior.ColorIndex = 33  'Hellblau
Range("DK4, DM5, DG6").Interior.ColorIndex = 3  'Rot
Range("DO3, DL6, DK8, DO8, DI10").Interior.ColorIndex = 44  'Ockergelb
Range("DW10").Interior.ColorIndex = 7  'Magenta
' " Da sich der Bereich DH2-DV10 alle 20 Zeilen wiederholt,wird er kopiert "
For i = 2 To 622 Step 20
.Range("DH2:DV10").Copy .Cells(i, 112)
If i = 622 Then Exit For
.Range("DH2:DV10").Copy .Cells(i + 20, 112)
Next
End With
End Sub
Das Kopieren des Bereichs war für mich jetzt die einfachste Lösung. Ich weiß,das es auch über die For - Next - Schleife geht.
Anregungen und Kritik sind erwünscht.
Lg Frank

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige