Jede Reihe nur einmal in "application.selection"

Hallo zusammen,
ich stehe gerade vor dem Problem, dass ich von einem Bereich "Application.Selection" nur jede Zeile einmal abrufen möchte.
Hintergrund ist der, dass der Anwender per Knopfdruck ein Modul startet, bei dem dann in jeder Zeile in einer Spalte ein Eintrag gesetzt wird.
Markiert: "A3:A5", "B4:B5"
Wenn ich dies so löse, dann gibt es jede Zelle, also insgesamt 5 Stück:


Sub Knopf()
dim Rng as range
set Rng = Intersect(Application.Selection,Activesheet.Cells)
Dim Zelle as range
For each Zelle in Rng
' machewas mit Zelle.row
next Zelle
End Sub

>>
Ich möchte aber nur die Zeilen 3,4,5 verwenden und diese nicht doppelt!
Eine Möglichkeit habe ich, dass ich die Selection-Bereich in ein Array einlesen - erscheint mir aber recht zeitintensiv!
Gibt es hierzu vielleicht eine elegante Lösung?
Gruß,
Oliver

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Knopf() Dim Zeile() As Long, _ AnzZeilen As Long, _ Rng As Range, _ i As Long, _ j As Long, _ springen As Boolean 'In jedem Bereich Anzahl Zeilen ermitteln For Each Rng In Selection.Areas AnzZeilen = AnzZeilen + Rng.Rows.Count Next Rng 'Maximale Anzahl zeilen in Feldvar. bereitstellen ReDim Zeile(AnzZeilen) 'nächsten freien Zeilenspeicher vorgeben j = 1 'Alle Zeilen durchgehen (auch doppelt markierte!) For Each Rng In Selection.Rows 'ermitteln, ob die aktuelle Zeile schon bearbeitet wurde springen = False For i = 1 To AnzZeilen If Rng.Row = Zeile(i) Then springen = True Next i 'wenn nicht, jetzt bearbeiten ... If Not springen Then Debug.Print "Bearbeite Zeile " & Rng.Row '... und den nächsten freien Zeilenspeicher vorgeben Zeile(j) = Rng.Row j = j + 1 End If Next Rng End Sub

Sub til() Dim lMinRow As Long Dim lMaxRow As Long Dim rSingle As Range lMinRow = ActiveSheet.Rows.Count For Each rSingle In Selection.Areas If rSingle.Row lMaxRow Then lMaxRow = rSingle.Row + rSingle. _ Rows.Count - 1 Next MsgBox "Do something for Rows " & lMinRow & " to " & lMaxRow End Sub

Sub til() Dim lMinRow As Long Dim lMaxRow As Long Dim rSingle As Range lMinRow = ActiveSheet.Rows.Count For Each rSingle In Selection.Areas If rSingle.Row lMaxRow Then _ lMaxRow = rSingle.Row + rSingle.Rows.Count - 1 Next For Each rSingle In ActiveSheet.Rows(lMinRow & ":" & lMaxRow) If Not (Intersect(Selection, rSingle) Is Nothing) Then MsgBox "We now do something for row " & rSingle.Row End If Next End Sub

Sub Bereich_auslesen(r_akt_arr() As Long, Target As Range) '*******Variablen-Deklaration******* Dim i1 As Integer, i2 As Integer '*** Dim r_akt As Long '*** '*******Zeilen auslesen******* ReDim Preserve r_akt_arr(0) '*** r_akt_arr(0) = Target.Areas(1).Cells(1).row '*** For i1 = 1 To Target.Areas.Count For i2 = 1 To Target.Areas(i1).Cells.Count If IsError(Application.Match(Target.Areas(i1).Cells(i2).row, r_akt_arr, 0)) = True Then ReDim Preserve r_akt_arr(UBound(r_akt_arr) + 1) '*** r_akt_arr(UBound(r_akt_arr)) = Target.Areas(i1).Cells(i2).row '*** End If Next i2 Next i1 End Sub

Beliebteste Forumthreads (12 Monate)

Jede Reihe nur einmal in "application.selection"

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Jede Reihe nur einmal in "application.selection"

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread