<pre>
Public Function PT_GetRecordset(ByVal sqlSelect As String, _
ByVal sqlFrom As String, _
ByVal sqlWhere As String, _
Optional ByRef NumRows As Long, _
Optional ByRef NumFields As Long)

Dim CriteraAND, splTMP, ErgebnisZeile(), sSelect As Variant
Dim CritField(), CritVal() As String
Dim i, AngezeigteSpalten, ErsteSichtbareZeile, intCT, intCT2, Abzug As Integer
Dim r As Range
On Error GoTo fehler
PT_GetRecordset = ErgebnisZeile
If GetSpalten = "@" Then MsgBox "Erste Zelle der Tabelle '" & sqlFrom & _
"' ist leer!", vbInformation, _
"PT_GetRecordSet": Exit Function
sSelect = Split(sqlSelect, ",")
Sheets(sqlFrom).Select
CriteraAND = Split(UCase(sqlWhere), "AND")
Range("A:" & GetSpalten).Select
Selection.AutoFilter
If LCase(sqlWhere) <> "true" Then
For i = 0 To UBound(CriteraAND)
splTMP = Split(CriteraAND(i), "=")
ReDim Preserve CritField(i)
ReDim Preserve CritVal(i)
CritField(i) = Trim$(splTMP(0))
CritVal(i) = Trim$(splTMP(1))
Next
Selection.AutoFilter Field:=GetColumnIndex(CritField(0), Range("1:1")), _
Criteria1:="=" & CritVal(0), Operator:=xlAnd
For i = 0 To UBound(CritField)
If CritField(i) <> "" Then Selection.AutoFilter Field:=GetColumnIndex(CritField(i), _
Range("1:1")), Criteria1:="=" & CritVal(i), _
Operator:=xlAnd Else Exit For
Next
Else
Selection.AutoFilter
End If
For Each r In Range("A:A")
If r.RowHeight <> 0 And r.Row <> 1 Then Exit For
Next
ErsteSichtbareZeile = r.Row
For Each r In Range("A:A")
If r = "" And r.Row >= ErsteSichtbareZeile Then Exit For
If r.RowHeight > 0 And r.Row >= ErsteSichtbareZeile Then Abzug = Abzug + 1
Next
NumRows = r.Row - ErsteSichtbareZeile - Abzug - 1
If sqlSelect <> "*" Then
If LCase(sqlWhere) <> "true" Then ReDim ErgebnisZeile(NumRows, UBound(sSelect)) Else _
ReDim ErgebnisZeile(r.Row, UBound(sSelect))
Else
If LCase(sqlWhere) <> "true" Then ReDim ErgebnisZeile(NumRows, GetSpaltenIndex) Else _
ReDim ErgebnisZeile(r.Row, UBound(sSelect))
End If
intCT = 1
For Each r In Range("A:A")
If r = "" And r.Row >= ErsteSichtbareZeile Then Exit For
If r.RowHeight > 0 And r.Row >= ErsteSichtbareZeile Then
intCT2 = 0
For i = 1 To GetSpaltenIndex
If InStr(1, sqlSelect, Range(Chr$(64 + i) & "1")) Or sqlSelect = "*" Then
ErgebnisZeile(intCT - 1, intCT2) = Range(Chr$(64 + i) & r.Row)
intCT2 = intCT2 + 1
End If
Next
intCT = intCT + 1
End If
Next
NumFields = intCT2
PT_GetRecordset = ErgebnisZeile
Exit Function
fehler:
MsgBox "Fehler:" & vbCrLf & _
vbCrLf & _
"sqlSelect = " & sqlSelect & vbCrLf & _
"sqlFrom = " & sqlFrom & vbCrLf & _
"sqlWhere = " & sqlWhere, _
vbInformation, "PT_GetRecordset"
End Function

Function GetColumnIndex(varSearch As Variant, rng As Range) As Integer
Dim var As Variant
Dim iCol As Integer
For iCol = 1 To rng.Columns.Count
var = Application.Match(varSearch, rng.Columns(iCol), 0)
If Not IsError(var) Then
GetColumnIndex = iCol
Exit Function
End If
Next iCol
End Function

Function GetSpalten() As String
Dim r As Range
Dim intCount As Integer
For Each r In Range("1:1")
If Trim$(r) <> "" Then intCount = intCount + 1 Else Exit For
Next
GetSpalten = Chr$(64 + intCount)
End Function

Function GetSpaltenIndex() As Integer
Dim r As Range
Dim intCount As Integer
For Each r In Range("1:1")
If Trim$(r) <> "" Then intCount = intCount + 1 Else Exit For
Next
GetSpaltenIndex = intCount
End Function

'[in] sqlSelect Kommagetrennter String mit Rückgabe Feldern ("Feld1, Feld2")
'[in] sqlFrom Name der Tabelle ("Tabelle1")
'[in] sqlWhere Auswahlkriterien ("Feld3=4 AND Feld4=5")
'[out] NumRows Anzahl der gefundenen Zeilen (3)
'[out] NumFields Anzahl der Rückgabe Spalten (2)
'
'Die Funktion liefert dann ein doppeltes Array mit den Werten,
'oder Empty wenn keine Übereinstimmung.
'z.b. Rückgabe(0)(0) = 1, Rückgabe(0)(1) = 2 ...
'
'Besonderheiten:
'sqlSelect = "*" -> Alle Spalten
'sqlWhere = "True" -> Keine Bedingungen
</pre>

Aufgerufen wir das ganze etwa so:

<pre>Sub Schaltfläche1_BeiKlick()
Dim RV As Variant

RV = PT_GetRecordset("Name,Strasse", "Tabelle1", "Wohnort=Stuttgart AND Hausnummer=65")

MsgBox RV(0, 0)
End Sub
</pre>

hab ich auf der arbeit zusammenstellen müssen (für eine konvertierung einer access-anwendung nach excel).. 8)

p.s. wie macht man hier im forum, dass mehrere leerzeichen hintereinander angezeigt werden? ich hätt's mit "& nbsp;" gemacht, da wird die nachricht aber zu lang

//edit: dank markus seinem tipp "CODE.." ist das problem gelöst

Versuch's doch mal mit drumherum. Das ist wie der <PRE>-Tag in HTML.

Was meinst du mit "die Nachricht wird zu lang"? Posts in diesem Unterforum dürfen 10.000 Zeichen lang sein, dein Post hat unter 5.000.

also, bisher hab ich bei den leerzeichen für die zeileneinrückung immer "& nbsp" (ohne leerzeichen zwischen "&" und "nbsp"), da das ein leerzeichen erzwungen hat ("&nbsp"), weil sonst hat das forum die immer weggemacht . und mit den "& nbsp's" wird das posting über 10.000 zeichen lang

Bearbeite deinen Post mal bitte so, dass er nicht mehr so breit ist. Das zerstört sonst das Forum-Layout (zumindest in diesem Thread).