Suchfunktion geschlossene Datei und Tabellenblatt
11.04.2018 14:21:30
Sophie
ich würde in meinen Code gerne eine Suchfunktion integrieren, habe bisher allerdings noch nichts passendes gefunden um es mir anzupassen und kenne mich leider nicht so gut aus, dass ich mir selbst einfach so etwas schreiben könnte.
Momentane Situation: Ich habe ein Tool, das aus Startseite und Schnittstelle besteht. Die Startseite hat bislang noch keinen Einfluss. Die Schnittstelle holt sich bei Drücken eines Buttons eine Spalte aus einer geschlossenen Datenbank. Das klappt auch gut, nur würde ich gerne eine Suche integrieren. Ich möchte auf der Startseite Hersteller und Typ angeben und dann soll im Ordner "Datenbanken" die richtige Datei (=Hersteller) und darin dann das passende Tabellenblatt (=Typ) gesucht und die benötigte Spalte übertragen werden.
Hier das Tool: https://www.herber.de/bbs/user/120997.xlsm
Hier die Datenbank (musste Werte löschen weil zu groß; hoffe es funktioniert noch): https://www.herber.de/bbs/user/121000.xlsb
Code:
Private Function GetValue(pfad, datei, blatt, zelle)
'Dimensionierung der Variablen
Dim arg As String
'Sicherstellen, dass Datei existiert
If Right(pfad, 1) "\" Then pfad = pfad & "\"
If Dir(pfad & datei) = "" Then
GetValue = "Datei nicht gefunden"
Exit Function
End If
'Das Argument erstellen
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).
_Range("A1").Address(, , x1R1C1)
'Auslesen über Excel4Macro
GetValue = ExecuteExcel4Macro(arg)
End Function
Sub Winddaten_auslesen() 'Bereich auslesen, Excel4Macro
Winddaten_löschen
'Dimensionierung der Variablen
Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object
_'Variablen für das Auslesen
Dim zeileneu As Integer, spalteneu As Integer, zelleneu As String 'Variablen für den
_Offset (um Werte an anderer Stelle als die in der Datenbank einzufügen)
'Angaben zu den auszulesenden Zellen und Offset
pfad = "C:\Users\SophieB\Documents"
datei = "Enercon.xlsx"
blatt = "E112"
Set bereich = Range("H10:H500") 'Ende liegt bei H8759,
_zum Testen max. 1000 angeben wegen der Dauer
'Offset, relativ zu Ursprungszeile/-spalte
zeileneu = "-6"
spalteneu = "-5"
'Bereich auslesen
For Each zelle In bereich
Application.StatusBar = "Lade Winddaten..." 'zeigt Text in Statusleiste an
'Zellen umwandeln
zelleneu = zelle.Address(False, False)
'Eintragen in Bereich
ActiveSheet.Cells(zelle.Row, zelle.Column).Offset(zeileneu, spalteneu).Value = _
GetValue(pfad, datei, blatt, zelleneu)
Next zelle
Application.StatusBar = False 'blendet Text in Statusleiste aus
End Sub
Hatte mir schon mal mit
Sub Suche()
Dim SucheHersteller as String, SucheTyp as String
SucheHersteller = Sheets("Tabelle1").Cells(3, 2)
SucheTyp = Sheets("Tabelle1").Cells(4, 2)
MsgBox (SucheHersteller)
MsgBox (SucheTyp)
End Sub
Danke und Grüße, Sophie