Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
532to536
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
532to536
532to536
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Array durchsuchen nach werten

Array durchsuchen nach werten
20.12.2004 10:24:47
Chris
Hallo VBA Profis,
habe eine frage ist es irgendwie möglich ein Array nach werten zu durchsuchen und die gefundenen werte in eine Tabelle einzutragen ?Folgendes Beispiel habe ich vorbereitet.
Dim cb()
Sub neu()
For x = 1 To 100
ReDim Preserve cb(x)
cb(x) = Cells(x, 1)
Next
End Sub
Mit diesem lese ich die werte aus den zellen 1 bis 100 in ein Array ein. Nun möchte ich z.B das ich em ende wenn ich eine find bedngung eingeben nur noch die werte die der bedingung entsprechen in einen Excel tabelle ausgegeben werden.
Ich hoffe mann hat verstanden wa sich meine. Momentan habe ich es etwas umständlich gemacht :( Ich schreibe alle werte nicht in ein array sondern erstelle ein neues Sheet. Der Code hier: und diesen möchte ich gerne verbessern.
Dim suche
Dim dateiname As String, i As Integer

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Makros Start nur bei Doppelklick in Spalte "C"
If Target.Column <> 3 Then
Exit Sub
Else
End If
'Doppelgeklickten Wert in Variable schreiben
suche = Target.Value
'neues tabellenblatt hinzufügen  (Wird am ende wieder gelöscht)
Worksheets.Add
neusheet = ActiveSheet.Name
'Neues Tabellenblatt mit daten füllen
i = 1
dateiname = Dir$("O:\Sekretariat\Dokumente\FMEA\FMEA Dateien IQ-FMEA\*.fme")
Do While dateiname <> ""
Worksheets(neusheet).Cells(i, 1) = dateiname
i = i + 1
dateiname = Dir$()
Loop
' suchen nach doppelgeklicktem Zellinhalt
Set zelle = Worksheets(neusheet).Range("A:A").Find(what:=suche, Lookat:=xlPart)
If Not zelle Is Nothing Then
treffer = 1
ersteAdresse = zelle.Address
Do
'Doppelgeklicken Zellinhalt in Tabelle schreiben
Worksheets(neusheet).Cells(treffer, 3) = Worksheets(neusheet).Range(zelle.Address)
treffer = treffer + 1
'MsgBox zelle.Address
Set zelle = Range("A:A").FindNext(zelle)
Loop While Not zelle Is Nothing And zelle.Address <> ersteAdresse
End If
End Sub

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Array durchsuchen nach werten
Ramses
Hallo
grundsätzlich sollte es so gehen
Option Explicit
Dim cb(100)

Sub neu()
Dim x As Integer, i As Integer
For x = 1 To 100
'Kann entfallen
'Allenfalls nachträglich dimensionieren wenn nicht
'soviele Einträge gebraucht werden
'ReDim Preserve cb(x)
cb(x) = Cells(x, 1)
Next x
'Zählung des Arrays beginnt bei 0
For i = 0 To 99
'oder
'For i = 1 To 100
'0 - 99
If cb(i) = "5" Then
'oder 1 to 100
'If cb(i - 1) = "5" Then
'0-99
Range("B1") = cb(i)
'oder
'1 to 100
'Range("B1") = cb(i - 1)
End If
Next i
End Sub

Gruss Rainer
AW: Array durchsuchen nach werten
20.12.2004 13:48:06
chris
Hallo rainer,
vielen Dank erst mal für deinen Tipp.
Nur leider ist das nicht das was ich wollte.
Habe jetzt auch das alte system gelassen.
weil ich gebe nicht genaue bezeichnungen an. Wollte es so verwenden wie mit der find funktion die auch ähnliche treffer also fundtreffer zählt.
Aber wie gesagt erledigt Danke !
Anzeige
AW: Array durchsuchen nach werten
Boris
Hi Chris,
Wollte es so verwenden wie mit der find funktion die auch ähnliche treffer also fundtreffer zählt.
Find kannst du zwar auf ein Array nicht "loslassen", dafür kannst du doch aber mit dem Like-Operator (in Verbindung mit den *) nach Vorkommen suchen - ggfls. noch mit UCASE oder LCASE arbeiten, da Like zwischen Groß-und Kleinschreibung unterscheidet.
So kannst du den Code von Ramses auch problemlos verwenden.
Grüße Boris
AW: Array durchsuchen nach werten
22.12.2004 21:30:51
chris
Vielen Dank euch beiden !

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige