Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 13:44:05
Bezeichnung Tabellenblatt aus Zelle für Formel auslesen
24.04.2024 12:38:40
Formeländerung durch Wechsel von Excel 2021 auf 2019
24.04.2024 12:31:18
Excel - Sverweis mit Wenn-Abfrage kombinieren
24.04.2024 12:16:26
Name von aktuellem VBA-Modul ausgeben
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1632to1636
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
1632to1636
1632to1636
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zeilennummer bei gesetztem Filter auslesen

Zeilennummer bei gesetztem Filter auslesen
14.07.2018 12:41:21
Siegfried
Hallo @alle,
wer hat bitte einen Lösungsvorschlag für folgendes Problem welches im jetzigen Zustand eine BREMSE ist.
Ich muss ca. 23.000 Datensätze durchlaufen, dabei werden aber immer wieder verschiedene Filter gesetzt. Je nach Filter entstehen daher zwischen den Zeilennummer Sprünge von bis zu 1.000 Datensätzen. Da die Abfrage aber nun ausgeblendete Datensätze auch durchläuft, siehe 
    For lngzeile = slngzeile To Cells(2, 2).End(xlDown).Row
If Not Rows(lngzeile).Hidden Then
InputRow = lngzeile
wRow = InputRow
For wRow = wRow To EndRow
s = Cells(wRow, wSpa).Value
wLand = Cells(wRow, 13)
InputRow = wRow
If Len(s) > 0 Then
Call UPI_KML_PLZ_Ort(Cells(wRow, wSpa).Value, A00, wLand, wCol)
Cells(wRow, wSpa).Font.ColorIndex = 3
Cells(wRow, wSpa).Value = Trim(s)
End If
If MaxLines > 50 Then
With ActiveWindow.VisibleRange
ZeileL = .Row + .Rows.Count – 1
End With
If wRow >= ZeileL Then
ActiveWindow.ScrollRow = wRow
Application.Wait Time:=Now + TimeSerial(0, 0, 0.2)
End If
End If
Next wRow
End If
If wRow >= MaxLines Then Exit For
Next

verlängert sich der Durchlauf natürlich sehr.
Frage gibt es eine Möglichkeit nicht ausgeblendete Zeilennummer abzufragen und daher die FOR NEXT Schleife bei dieser Zeilennummer fortzusetzen.
Wäre schön wenn mir da jemand eine mögliche Lösung zeigen könnte!
Gruß Siegfried

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: SpecialCells
14.07.2018 12:56:11
Fennek
Hallo,
teste mal

Z_Nr = columns(1).specialcells(12).areas(1).cells(2)
mfg
AW: SpecialCells
14.07.2018 13:30:35
Siegfried
Hallo @Fennek,
nein ist leider nicht die Lösung den in Z_Nr hat er den Wert der A-Spalte und nicht die Zeilennummer.
Userbild
AW: Korrektur
14.07.2018 13:44:48
Fennek
Hi,
wieder ungeprüft, aber es müßte ein .Row fehlen, also:

Z_Nr = columns(1).specialcells(12).areas(1).cells(2).row
mfg
AW: Korrektur der Korrektur
14.07.2018 13:56:59
Fennek
Früher hies es "man müßte bis 3 zählen können", hier reicht es bis 2

Z_Nr = columns(1).specialcells(12).areas(2).cells(1).row
mfg
getestet
Anzeige
AW: SpecialCells
14.07.2018 14:14:56
Luschi
Hallo Siegfried
ich mach das immer so: 

Sub test1()
Dim rg As Range, rgF As Range
Set rg = ActiveSheet.AutoFilter.Range.Columns(1)
On Error Resume Next
Set rgF = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(12)
On Error GoTo 0
If rgF Is Nothing Then
MsgBox "kein Filter eingeschalten!", 4096 + 16
GoTo AllesAus
ElseIf rg.Cells.Count = rgF.Cells.Count Then
MsgBox "Daten nicht gefiltert!", 4096 + 16
GoTo AllesAus
End If
'und hier gehts weiter
Debug.Print rgF.Address
AllesAus:
Set rg = Nothing: Set rgF = Nothing
End Sub
Gruß von Luschi
aus klein-Paris
Anzeige
AW: SpecialCells
14.07.2018 15:16:16
Siegfried
Hi @Luschin,
habe es mir angesehen kann aber mit der letzten Zeile
Debug.Print rgF.Address
nicht wirklich bzw. nichts richtig anfangen.
Sehe zwar das darin alle Zeilennummer welche offen sind stehen aber wie sollte ich da mir jetzt die nächste zutreffende herausholen?
MfG
AW: SpecialCells
14.07.2018 20:53:30
Werner
Hallo Siegfried,
also ich verstehe jetzt das Problem nicht wirklich.
mit Debug.Print rgF.Address wollte dir Luschi doch nur im Direktfenster zeigen, dass das Rangeobjekt rgF genau das enthält, was du willst. Nur die Adressen, die vom Filter angezeigt werden.
Jetzt kannst du doch mit einer Schleife über diese Rangeobjekt genau das erreichen, was du willst. Es wird nur das durchlaufen, was der Filter dir anzeigt.
For Each Zelle in rgF
...hier dein Code
Next Zelle
Gruß Werner
Anzeige
AW: SpecialCells
15.07.2018 09:51:47
Luschi
Hallo Werner,
da kann man doch sich nur noch wundern, was alles die User mit Vba erledigen wollen, aber von den banalsten Grundfertigkeiten beim Testen des Vba-Codes NULL Ahnung haben und noch nicht mal wissen, daß es auch eine Hilfe in Form der F1-Taste gibt.
Gruß von Luschi
aus klein-Paris
AW: SpecialCells
15.07.2018 10:25:23
Siegfried
Morgen @Luschi,
nun besonders nett finde ich deine Anmerkung an Werner für mich ja gerade nicht, aber ich werde es als 74 Jähriger wohl verkraften.
Ja das habe ich schon gesehen, dass im rgF genau die gefilterten Zeilennummern stehen würden, nur wie ich an die dran komme ist für mich momentan ein spanisches Dorf.
Von VBA habe ich sehr wenig Ahnung, durch meine Hilferufe hier im Forum lerne ich aber immer wieder dazu und da ich vor Jahren mal mit CLIPPER so einiges machte habe ich für VBA ein bisschen verständniss aber von solchen Spezialitäten wie du mir hier gezeigt hast halt nicht die leiseste Ahnung.
DANKE Jedenfalls für deine Unterstützung, notfalls muss ich mich eben mit meinem bereits erstellen Source, welcher halt jede Zeilennummer abfragt, zufrieden geben.
Gruß Siegfried
Anzeige
AW: SpecialCells
16.07.2018 15:59:08
Siegfried
Hi @Luschi,
es sind eben nicht alle als Programmierer auf die Welt gekommenen 
Sub Filter_ZlNr()
Dim rg As Range, rgF As Range
Dim rgF_len, rgF_Inh, rgF_Arr As Variant
Dim x, wRow, position As Integer
Set rg = ActiveSheet.autoFilter.Range.Columns(1)
On Error Resume Next
Set rgF = ActiveSheet.autoFilter.Range.Columns(1).SpecialCells(12)
On Error GoTo 0
If rgF Is Nothing Then
MsgBox "kein Filter eingeschalten!", 4096 + 16
GoTo AllesAus
ElseIf rg.Cells.Count = rgF.Cells.Count Then
MsgBox "Daten nicht gefiltert!", 4096 + 16
GoTo AllesAus
End If
'und hier gehts weiter
Debug.Print rgF.Address
rgF_Inh = Replace(rgF.Address, "$A$1,", "")
rgF_Inh = Replace(rgF_Inh, "$A$1:", "$A$2:")
rgF_Inh = Replace(rgF_Inh, "$A$", "")
If InStr(1, rgF_Inh, ":") = 0 Then
rgF_Inh = rgF_Inh & ":" & rgF_Inh
End If
rgF_Arr = Split(rgF_Inh, ",")
rgF_len = UBound(rgF_Arr)
ZlArr = Array()
ReDim ZlArr(rgF_len, 1 To 2)
For x = 0 To rgF_len
position = InStr(1, rgF_Arr(x), ":")
If position > 0 Then
ZlArr(x, 1) = Trim(Left(rgF_Arr(x), position - 1))
ZlArr(x, 2) = Trim(Mid(rgF_Arr(x), position + 1, 10))
End If
Next
AllesAus:
Set rg = Nothing: Set rgF = Nothing
Set rgF_Inh = Nothing: Set rgF_Arr = Nothing
End Sub

Deine Vorgabe sieht nun bei mir so aus und läuft auch bestens.
Nur deine 2x MsgBox trifft nie zu, auch nicht wenn kein Filter gesetzt ist, oder sehe ich da was falsch.
Bzw. wenn ich eine bestimmte Spalte auswähle und kein Filter gesetzt ist, welche abgearbeitet werden soll, setzt er einen Filter auf alle Zeilen die leer sind, wieso warum, wie könnte man das unterbinden.
Schon mal ein DANKE für Aufklärung und weitere Unterstützung!
Gruß Siegfried
Anzeige
AW: SpecialCells
20.07.2018 00:09:57
Siegfried
Hallo @Luschi,
dachte ich bekomme zu meiner Nachfrage vom 17/07/18 von dir eine Antwort, aber leider haabe ich mich da geirrt wie ich feststellen muss!
Gruß Siegfried
AW: SpecialCells
14.07.2018 14:45:50
Siegfried
Hi @Fennek,
nun mit deiner letzten Korrektur bringt er mir zwar jetzt die Zeilennummer aber immer die erste des gesetzten Filters.
Ich bräuchte aber die nächste nach der letzten abgearbeiteten (wRow) um eben damit einen Sprung über eventuell ausgeblendete zu machen.
Gruß Siegfried
P.S.
zu @Luschi,
ist mir momentan etwas zu hoch, muss mich da erst einlesen bzw. rein denken
Anzeige
AW: Ende
14.07.2018 15:31:26
Fennek
Hallo,
der folgende Code iteriert durch alle Zeile, die der Autofilter anzeigt. Hier in den Foren ist dieser Ansatz recht unbeliebt, aber bis auf die letzte Zeile klappt es.
Jetzt ist WM-Zeit!

Sub T_1()
With Cells(1).CurrentRegion.Columns(1).SpecialCells(12).Offset(1)
If .Areas.Count > 1 Then
.Select
For Each c In Selection
c.Offset(, 1) = "s" 'hier die Berechnung
Next c
End If
End With
End Sub
mfg

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige