Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1316to1320
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
Inhaltsverzeichnis

Find NExt ohne active cell

Find NExt ohne active cell
26.06.2013 15:03:56
JACKD
Hallo Gemeinde ich hätte wieder mal ein anliegen, bei dem ich selber nicht weiterkomme.
Ich hab eine Userform mit
1 Textbox zur eingabe
5 textboxen zur ausgabe
sowie 2 Buttons (vorwärts und rückwärts suchen)
Bisher hab ich das
so gelöst
(Bei eingabe in Textbox1 fängt er an mit suchen und ergänzt das mit jedem weiteren Buchstaben)
jetzt ist es so dass ich dass als addin implementieren möchte die Tabelle ist also im Hintergrund
Und kann sie ja jetzt nicht mehr mit activecell ansprechen
wie kann ich dass denn umgehen?
Private Sub TextBox1_Change()
With tabNC.Columns(3)
If .Find(khspez.TextBox1.Value) Is Nothing Then Exit Sub
.Find (khspez.TextBox1.Value)
raumdef = ActiveCell.Value                          'Raumbezeichnung
raumdef1 = ActiveCell.Offset(0, -2).Value           'Raumcode
If .Cells.FindNext(after:=ActiveCell) Is Nothing Then Exit Sub
.Cells.FindNext(after:=ActiveCell).Select
raumdef2 = ActiveCell.Value                         'Raumbezeichnung
raumdef3 = ActiveCell.Offset(0, -2).Value           'Raumcode
If .Cells.FindNext(after:=ActiveCell) Is Nothing Then Exit Sub
.Cells.FindNext(after:=ActiveCell).Select
raumdef4 = ActiveCell.Value                         'Raumbezeichnung
raumdef5 = ActiveCell.Offset(0, -2).Value           'Raumcode
If .Cells.FindNext(after:=ActiveCell) Is Nothing Then Exit Sub
.Cells.FindNext(after:=ActiveCell).Select
raumdef6 = ActiveCell.Value                         'Raumbezeichnung
raumdef7 = ActiveCell.Offset(0, -2).Value           'Raumcode
If .Cells.FindNext(after:=ActiveCell) Is Nothing Then Exit Sub
.Cells.FindNext(after:=ActiveCell).Select
raumdef8 = ActiveCell.Value                         'Raumbezeichnung
raumdef9 = ActiveCell.Offset(0, -2).Value           'Raumcode
If .Cells.FindNext(after:=ActiveCell) Is Nothing Then Exit Sub
.Cells.FindNext(after:=ActiveCell).Select
raumdef10 = ActiveCell.Value                         'Raumbezeichnung
raumdef11 = ActiveCell.Offset(0, -2).Value           'Raumcode
End With
khspez.TextBox3.Value = raumdef
khspez.TextBox14.Value = raumdef1
khspez.TextBox5.Value = raumdef2
khspez.TextBox15.Value = raumdef3
khspez.TextBox7.Value = raumdef4
khspez.TextBox16.Value = raumdef5
khspez.TextBox9.Value = raumdef6
khspez.TextBox17.Value = raumdef7
khspez.TextBox11.Value = raumdef8
khspez.TextBox18.Value = raumdef9
khspez.TextBox13.Value = raumdef10
khspez.TextBox19.Value = raumdef11
End Sub

Grüße

28
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Find NExt ohne active cell
26.06.2013 15:39:01
Rudi
Hallo,
per Range-Object
Schema:
Private Sub TextBox1_Change()
Dim rngF As Range
With tabNC.Columns(3)
Set rngF = .Find(khspez.TextBox1.Value)
If rngF Is Nothing Then Exit Sub
raumdef = rngF.Value                          'Raumbezeichnung
raumdef1 = rngF.Offset(0, -2).Value           'Raumcode
Set rngF = .Cells.FindNext(after:=rngF)
If rngF Is Nothing Then Exit Sub
raumdef2 = rngF.Value                         'Raumbezeichnung
raumdef3 = rngF.Offset(0, -2).Value           'Raumcode
die raumdef's würde ich in ein Array packen. Dim RaumDef(11)
Gruß
Rudi

Anzeige
AW: Find NExt ohne active cell
26.06.2013 16:19:16
JACKD
Spitze =)
Läuft.. vielen Dank =)
Grüße

Erweiterung
26.06.2013 16:30:35
JACKD
Hallo Rudi, Hallo Günther
wie kann ich denn die Routine verändern,wenn ich mit einem Button die nächsten ergebnisse anzeigen will?
Grüße

verstehe ich nicht
26.06.2013 16:44:17
Rudi
Hallo,
eine Beispielmappe wäre Hilfreich.
Gruß
Rudi

Kann ich verstehen :-)
26.06.2013 17:16:24
Jack
Kann leider grad keine hochladen, da ich die Mappe auf dem anderen Rechner hab,
Im Zweifel morgen. Dann.
Ansonsten.
Kurze Erläuterung.
Die Suchroutine textbox1_change die wir grad hatten ermittelt die Ersten 5 Treffer und gibt diese in den 5 textboxen aus.
(Klappt klaglos)
Nun ist neben der eingabetextbox(1)
Ein Pfeil nach rechts.
Sowie eine nach links
Damit möchte ich die Suchergebnisse weiterblattern. (In den tb 1-5)
Grüße

Anzeige
Guten Morgen
27.06.2013 09:46:34
JACKD
Hallo Gemeinde...
heute dann mit Muster
https://www.herber.de/bbs/user/86075.xlsm
Der interimsschalter dient nur dem Regeln der Addineigenschaft.
Der Code für das ereignis tbSuchfeld_change funktioniert gut (wenn er auch nicht schön ist)
die restlichen codesnippets irgendwie nicht
Vielen Dank für eure Hilfe.
Grüße

AW: Guten Morgen
27.06.2013 09:59:25
Rudi
Hallo,
das Beispiel is grenzwertig, genau wie dein Code.
Wonach willst du denn suchen? Laut Code nach der Raumbezeichnung (Spalte C?) Du hast ja leider keine Überschriften in der Tabelle. Überschriften sind ein Muss!.
Wenn du die Raumbeschreibung in C suchst, warum dann im Code in Cells anstatt Columns(3)?
Der Code beinhaltet nicht die Modifikationen mit dem Range-Objekt.
Alle Einträge in A:C sind einmalig.
Mach mal ein realistischeres Beispiel und erklär, was du willst.
Gruß
Rudi

Anzeige
mea culpa
27.06.2013 10:27:34
JACKD
Guten Morgen Rudi
Danke für deine Antwort.
Das der (ich nenn es mal "Code") etwas grenzwertig ist, ist mir bewusst.
Wonach willst du denn suchen? Laut Code nach der Raumbezeichnung (Spalte C?) Du hast ja leider keine Überschriften in der Tabelle. Überschriften sind ein Muss!.
Wenn du die Raumbeschreibung in C suchst, warum dann im Code in Cells anstatt Columns(3)?

Wonach will ich suchen:
Es ist so das ich einen Raum eingeben will in das tbSuchfeld und mit jedem weiteren Buchstaben soll er mir die mit dieser Buchstabenkombination verfügbaren Räume anbieten.
Mit CBVorwärts möchte ich dann (wenn mehr als 6 Ergebnisse Verfügbar sind , wie zb wenn ich Raum eingebe) die Suchergebnise durchklickern
Überschriften: ist ein ergebnis meiner "Fähigkeiten" als ich den Code ursprünglich mal angelegt hab, Wollte ich vermeiden dass er die Überschrift mit als ergebnis mit angibt
Spalte3 und nicht Zelle:
Mangels besseren Wissens
Der Code beinhaltet nicht die Modifikationen mit dem Range-Objekt.
Alle Einträge in A:C sind einmalig.

Modifikationen: habe ich nun nachgepflegt, hatte sie bis Dato nur bei dem Change ereignis eingebaut
Einmaligkeit: Ja das sind sie die Namen varriieren meist nur etwas (hab sie jetzt aber etwas angepasst)
Mach mal ein realistischeres Beispiel und erklär, was du willst.
Erklärung:
Ich Möchte in dem Suchfeld nacheinander Buchstaben eingeben, und anhand der eingegeben Buchstaben soll er mir die Ergebnisse ausgeben. Die kann je nach Buchstabenkombination mehr oder weniger sein.
Wenn Die Ergebnisanzahl größer 6 ist, möchte ich im weiteren mit den links und rechts Buttons alle Verfügbaren ergebnisse durchklicken.
Soweit zur Theorie. Dies hat auch noch funktioniert, als ich das als Tabelle behandelt hab (mit den Krücken Select und Activate) die allerdings innerhalb eines Addins nicht funktionieren. -.-
Anbei die Datei
https://www.herber.de/bbs/user/86078.xlsm
Und vielen Dank für deine Unterstützung
Grüße

Anzeige
Grundsatzfrage
27.06.2013 10:40:17
Rudi
Hallo,
warum liest du die Ergebnisse nicht einfach in eine Listbox anstatt der Textfelder ein?
Gruß
Rudi

AW: Grundsatzfrage
27.06.2013 10:47:49
JACKD
Hallo Rudi
auch das ist ein relikt aus "alten Tagen"
Die Userform war einst so aufgebaut das hinter den einzelnen Textboxen Checkboxen und weitere Buttons waren mit den ich dann die Werte eingetragen hab.
Nun wollt ich schnell (quasi quick and dirty) diese Userform umnutzen (für eine andere Fragestellung)
Aber daran scheitere ich gerade grandios.
Gegenfrage, bietet eine Listbox denn Vorteile? von der Übersichtlichkeit finde ich ja die Textboxen ganz vernünftig
Grüße

Anzeige
AW: Gegenfrage
27.06.2013 11:06:26
Rudi
Hallo,
finde ich schon.
Du siehst sofort alle Fundstellen und kannst per Listbox_Click weiteren Code anstoßen.
Beispiel.
Bau dir eine neue UF mit einer Textbox (TxtSuche) und einer Listbox (lbxErgebnis)
Code in der UF:
Private Sub txtSuche_Change()
With lbxErgebnis
.Clear
.ColumnCount = 3
.List = DieListe(txtSuche)
End With
End Sub
Private Sub UserForm_Activate()
With lbxErgebnis
.Clear
.ColumnCount = 3
.List = DieListe("")
End With
End Sub

In ein Modul:
Function DieListe(strMatch As String)
Dim arrTmp, i As Integer, objDaten As Object
Dim arrDaten(), arrKeys
Set objDaten = CreateObject("scripting.dictionary")
'Tabelle in Array
arrTmp = tabNC.Cells(1, 1).CurrentRegion
'Zeilennummern sammeln
For i = 2 To UBound(arrTmp)
If LCase(arrTmp(i, 3)) Like LCase(strMatch) & "*" Then
objDaten(i) = 0
End If
Next i
'Array für Fundstellen
If objDaten.Count Then
ReDim arrDaten(1 To objDaten.Count, 1 To 3)
arrKeys = objDaten.keys
For i = 0 To UBound(arrKeys)
arrDaten(i + 1, 1) = arrTmp(arrKeys(i), 1)
arrDaten(i + 1, 2) = arrTmp(arrKeys(i), 3)
arrDaten(i + 1, 3) = arrTmp(arrKeys(i), 5)
Next
DieListe = arrDaten
Else
DieListe = Array("Nix gefunden")
End If
End Function
Sieht kompliziert aus, ist aber rattenschnell.
Gruß
Rudi

Anzeige
Meine geliebten Array's
27.06.2013 11:31:06
JACKD
Hallo Rudi..
:-D
Haste wieder ne besonders schöne Lösung für mich gefunden ( die ich wieder ewig nicht verstehe :-D)
das "Ding" ist wirklich "sackschnell"
Das mit der Listbox ist zwar gewöhnungsbedürftig, aber man kann sich ja an alles gewöhnen. =)
Leider bildet die Funktion eines nicht ab, und zwar die "in-String" suche
also wenn ich nach zimmer suche, soll er alle Räume die "*zimmer*" enthalten auch mit anzeigen
Grüße
Und vielen vielen Dank für deine Hilfe

In-String-Suche
27.06.2013 11:39:04
Rudi
Hallo,
ganz einfach:
'Zeilennummern sammeln
For i = 2 To UBound(arrTmp)
If LCase(arrTmp(i, 3)) Like "*" & LCase(strMatch) & "*" Then
objDaten(i) = 0
End If
Next i
Gruß
Rudi

Anzeige
AW: In-String-Suche
27.06.2013 11:45:44
JACKD
Hab ich bereits gesehen =)
Aber danke dennoch =) bist heut mein persönlicher Held =)
Fällt dir spontan ein wert ein, aus dem Modul, den ich abgreifen könnte um die Listbox und die Userform in ihrer Länge dynamisch zu halten (also quasi in abhängigkeit der Trefferanzahl)?
Grüße

Länge dynamisch
27.06.2013 11:53:42
Rudi
Hallo,
du könntest lbxErgebnis.ListCount nutzen.
Wird aber ein ziemliches Gefummel. Du musst dann auch alle Steuerelemente verschieben, die sich unterhalb der LBx befinden.
Nach Größenänderung Repaint nicht vergessen.
Ich weiß auch nicht, ob mir das 'Gezucke' gefallen würde.
Gruß
Rudi

Anzeige
AW: Länge dynamisch
27.06.2013 12:08:23
JACKD
DA geb ich dir recht.. ich schau mir mal das ergebnis an =)
(sofern ich das hinkriege) =)
DA es eine reine anzeige UF Ist hab ich den Vorteil, dass keine weiteren Steuerelemente vorhanden sind.
Grüße

Länge haut hin
27.06.2013 12:29:35
JACKD
soweit, Rudi.
Allerdings, "nölt" er wenn ich alle lösche ne ganze weile rum.
Private Sub txtSuche_Change()
With lbxErgebnis
.Clear
.ColumnCount = 3
.List = DieListe(txtSuche)
End With
lbxErgebnis.Height = lbxErgebnis.ListCount * 12 + 10
Raumsuche.Height = lbxErgebnis.ListCount * 15 + 140
Raumsuche.Repaint
End Sub
Geht das auch analog der Stringlänge ?
Also die Breite der Userform und der Listbox
Ich hab es mit
lbxErgebnis.width = max(lenght(dieliste)) probiert
was aber nicht zum gewünschten ergebnis führt..
Grüße

Anzeige
AW: Länge haut hin
27.06.2013 13:10:45
Rudi
Hallo,
dann musst du
1. eine unproportionale Schriftart verwenden, z.B.Courier
2. die max. Länge der Einträge in jeder Spalte ermitteln, Schleife über die Liste
3. alle Spaltenbreiten anpassen
4. die Breite der LBx anpassen.
5. die Breite der UF anpassen
Gruß
Rudi

AW: Länge haut hin
27.06.2013 13:22:23
JACKD
Hallo Rudi
Ich bastel grad bissl..
komm aber nicht auf nen nenner
Variante1
Wie kann ich denn neben der Array Die Liste noch einen weiteren Wert ausgeben?
Function DieListe(strMatch As String)
Dim arrTmp, i As Integer, objDaten As Object
Dim arrDaten(), arrKeys
'Dim MaxLänge, maxLängeNeu
Set objDaten = CreateObject("scripting.dictionary")
'Tabelle in Array
arrTmp = tabNC.Cells(1, 1).CurrentRegion
'Zeilennummern sammeln
For i = 2 To UBound(arrTmp)
If LCase(arrTmp(i, 3)) Like LCase(strMatch) & "*" Then
objDaten(i) = 0
End If
Next i
'Array für Fundstellen
MaxLänge = 0
If objDaten.Count Then
ReDim arrDaten(1 To objDaten.Count, 1 To 4)
arrKeys = objDaten.keys
For i = 0 To UBound(arrKeys)
arrDaten(i + 1, 1) = arrTmp(arrKeys(i), 1)
arrDaten(i + 1, 2) = arrTmp(arrKeys(i), 3)
arrDaten(i + 1, 3) = arrTmp(arrKeys(i), 4)
'Länge einfügen
maxLängeNeu = Len(arrTmp(arrKeys(i), 3))
MaxLänge = WorksheetFunction.Max(MaxLänge, maxLängeNeu)
Next
DieListe = arrDaten
Else
DieListe = Array("Nix gefunden")
End If
End Function

Hier eingefügt die Maximale länge (funktioniert auch) ich kann nur den wert nicht übertragen -.-
(also aus der Function raus)
Variante 2
Function DieListe(strMatch As String)
Dim arrTmp, i As Integer, objDaten As Object
Dim arrDaten(), arrKeys
'Dim MaxLänge, maxLängeNeu
Set objDaten = CreateObject("scripting.dictionary")
'Tabelle in Array
arrTmp = tabNC.Cells(1, 1).CurrentRegion
'Zeilennummern sammeln
For i = 2 To UBound(arrTmp)
If LCase(arrTmp(i, 3)) Like LCase(strMatch) & "*" Then
objDaten(i) = 0
End If
Next i
'Array für Fundstellen
If objDaten.Count Then
ReDim arrDaten(1 To objDaten.Count, 1 To 4)
arrKeys = objDaten.keys
For i = 0 To UBound(arrKeys)
arrDaten(i + 1, 1) = arrTmp(arrKeys(i), 1)
arrDaten(i + 1, 2) = arrTmp(arrKeys(i), 3)
arrDaten(i + 1, 3) = arrTmp(arrKeys(i), 4)
'Länge einfügen
arrDaten(i + 1, 4) = Len(arrTmp(arrKeys(i), 3))
Next
DieListe = arrDaten
Else
DieListe = Array("Nix gefunden")
End If
End Function

Hier erweitere ich den Array der "Dieliste"
Trägt er auch ein
Aber ich bekomm es in der _change routine nicht abgefragt (ich komm irgendwie nicht an die Werte ran ) -.-
Grüße

AW: Länge haut hin
27.06.2013 14:22:53
Rudi
Hallo,
die max. Länge kannst du im txt_Change ermitteln.
Bsp.:
Private Sub txtSuche_Change()
Dim i As Integer, iMax As Integer
arrList = DieListe(txtSuche)
With lbxErgebnis
.Clear
.ColumnCount = 3
.Font.Name = "Courier New"
.Font.Size = 10
.List = DieListe(txtSuche)
For i = 0 To .ListCount - 1
'Länge 2.Spalte
iMax = WorksheetFunction.Max(iMax, Len(.List(i, 1)))
Next
.ColumnWidths = "20;" & iMax * 6.5 & ";20"
.Width = 60 + iMax * 6.5
Me.Width = .Left + .Width + 40
End With
Repaint
End Sub

Gruß
Rudi

Fantastisch
27.06.2013 15:07:22
JACKD
vielen Dank Rudi
Klappt wunderbar..
und du hast recht, ob das hin und her bewegen sinnvoll ist, bringt die zeit .. hab erstmal den Text dafür nur auskommentiert =)
Also vielen Dank dir
Grüße

Gefunden
27.06.2013 11:37:12
JACKD
Im Modul bei Like noch ein "*" davor setzen
For i = 2 To UBound(arrTmp)
If LCase(arrTmp(i, 3)) Like "*" & LCase(strMatch) & "*" Then
objDaten(i) = 0
End If
Next i
bringt das richtige Ergebnis
Gibts da noch was zu beachten? Also können da Fehler entstehen die ich grad nicht absehen kann?
Grüße

vorwärts-rückwärts
27.06.2013 15:11:44
Rudi
Hallo,
hatte gerade Lust.
In der UF:
Dim arrErgebnis, iIndex As Integer
Private Sub UserForm_Activate()
tbSuchefeld_Change
End Sub
Private Sub tbSuchefeld_Change()
'Suchen
arrErgebnis = DieListe(tbSuchefeld)
iIndex = 1
UpDateFields arrErgebnis, iIndex
End Sub
Private Sub cbVorwaerts_Click()
If iIndex  7 Then
iIndex = iIndex - 6
Else
iIndex = 1
End If
UpDateFields arrErgebnis, iIndex
End Sub

In ein Modul:
Sub UpDateFields(arrListe, iListe As Integer)
Dim i As Integer
With khspez
For i = 1 To 6
.Controls("tbRCode" & i) = ""
.Controls("tbRBez" & i) = ""
.Controls("tbKFA" & i) = ""
Next
For i = 1 To 6
If iListe - 1 + i 
Gruß
Rudi

Wozu du so alles-....
27.06.2013 15:51:02
JACKD
Lust hast =)
Aber die Lösung ist Top =)
Ich werd beides mit Reinnehmen und mich dann nach Tagesform entscheiden :-D
Grüße und vielen Dank

AW: Find NExt ohne active cell
26.06.2013 15:44:54
GuentherH
Hallo JackD,
Statt activecell eine Range-Variable nehmen.
Set Gefunden = .Find (khspez.TextBox1.Value)
If Gefunden = nothing...
...after:= Gefunden
Anmerkung: normalerweise bauchst Du noch eine Variable für die erste Fundstelle, und als Abbruchkriterium wenn findnext wieder auf die erste Fundstelle trifft.
Beste Grüße,
Günther

AW: Find NExt ohne active cell
26.06.2013 16:20:06
JACKD
Danke Guenther
(ist ja analog der Maintair´schen Lösung)
Grüße

Danke für die Rückmeldung
26.06.2013 16:24:35
GuentherH
ja, lief parallel

Rückmeldung
26.06.2013 16:31:57
JACKD
..sollte obligat sein Guenther...
da ja jeder eine gewisse Energie in die Sache steckt, sollte dies auch honoriert werden
Vielleicht fällt dir ja noch was zu Erweiterten Fragestellung (Nach Rudis Post) ein
Grüße

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige