Hallo liebe Excel-Experten.
Ich habe das folgende Problem bei dem Erstellen eines Makros in Excel. Der Sinn des Makros ist es in einer ausgewählten Spalte ab einer bestimmten vorgegebenen Zelle jede 10. zu markieren. also z.B. 2, 12, 22, 32, 42, 52... .
Hierfür markiere ich zuerst einen Bereich ab der Zahl mit der die Zählung anfangen soll (hier die 2, also wird z.B. die Spalte U folgendermaßen markiert: Range("U2:U1000").Select ~f~ ). Somit wird nun in dem Bereich gearbeitet, der groß genug ist um meine Wertetabelle nach unten abzudecken.
Nun zum Problem:
Der Code funktioniert bis zu: ~f~ Range("U2:U1000").Select ~f~ einwandfrei. Ab ~f~ Range("U11:U1000") ~f~ .Select und höher klappt es nicht mehr.
Kann einer von euch einen Fehler finden? Vielen Dank für die Hilfe!
Hier der Code:
Festlegen des Bereiches. Festlegen des Anfangs (BSP.: Anfang bei U2, Ende bei U1000 -> U3:U1000)
~f~
Range("U11:U1000").Select
' Initialize ColsSelection equal to the number of columns in the
' selection.
ColsSelection = Selection.Columns.Count
' Initialize RowsSelection equal to the number of rows in your
' selection.
RowsSelection = Selection.Rows.Count
' Initialize RowsBetween equal to three.
RowsBetween = 10
' Initialize Diff equal to one row less than the first row number of
' the selection.-
Diff = Selection.Row - 1
' Resize the selection to be 1 column wide and the same number of
' rows long as the initial selection.
Selection.Resize(RowsSelection, 1).Select
' Resize the selection to be every third row and the same number of
' columns wide as the original selection.
Set FinalRange = Selection. _
Offset(RowsBetween - 11, 0).Resize(1, ColsSelection)
' Loop through each cell in the selection.
For Each xCell In Selection
' If the row number is a multiple of 10, then . . .
If xCell.Row Mod RowsBetween = Diff Then
' ...reset FinalRange to include the union of the current
' FinalRange and the same number of columns.
Set FinalRange = Application.Union _
(FinalRange, xCell.Resize(1, ColsSelection))
' End check.
End If
' Iterate loop.
Next xCell
' Select the requested cells in the range.
FinalRange.Select
Selection.copy
Gruß
Max