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
1604to1608
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
Daten aus geschlossener Datei einlesen
27.01.2018 14:02:14
Rainer
Guten Tag,
ich habe vergeblich versucht die Prozeduren von Hajo vom 26.10.14 zum Thema 'Daten aus geschlossener Datei einlesen' an meine Bedürfnisse anzupassen. Die Sache funktioniert problemlos, wenn die Zelle in der Quelldatei und die Zelle in der Zieldatei bekannt sind. Meine Situation ist aber die, dass ich aus einer geschlossenen Datei mit Postleitzahlen eine bestimmte PLZ finden muss. Als Rückgabe benötige ich die Gemeinde, die in der Zelle neben der PLZ steht. Das Resultat (Gemeinde) soll an eine Variable (strGemeinde) übergeben werden. Pfad: "D:\Eigene Dateien\VBA\" Datei: "Postleitzahlen.xlsx", Worksheet: (1), Postleitzahlen in Spalte 1, Orte bzw Gemeinde in Spalte 2.
Vielen Dank für die Hilfe
Rainer.

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten aus geschlossener Datei einlesen
27.01.2018 14:33:47
Sepp
Hallo Rainer,
das geht doch ganz einfach per Formel!
Tabelle2

 AB
1PLZOrt
223456Test2

Formeln der Tabelle
ZelleFormel
B2=INDEX('E:\Forum\[Postleitzahlen.xlsx]Tabelle1'!$B:$B;VERGLEICH(A2;'E:\Forum\[Postleitzahlen.xlsx]Tabelle1'!$A:$A;0))


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Gruß Sepp

Anzeige
AW: Daten aus geschlossener Datei einlesen
27.01.2018 14:50:47
Rainer
Vielen Dank Sepp,
aber das ist nicht mein Problem. Ich habe eine UserForm gebaut in der der Anwender u.a. in die 'txtPLZ' eine PLZ eintippen soll. Die 'xtxGemeinde' in der selben UserForm soll dann die zur Postleitzahl passende Gemeinde darstellen. Dabei möchte ich vermeiden, dass die Datei mit den Postleitzahlen geöffnet und gleich wieder geschlossen wird.
Lg Rainer.
AW: Daten aus geschlossener Datei einlesen
27.01.2018 15:28:51
Luschi
Hallo Rainer,
auch Excel kann keine Gaten aus einer geschlossenen Datei wirklich auslesen.
Dabei wird die Möglichkeitt, die Datei per DDE für dem User unsichtbar zu öffnen
und dann auf die Daten zuzugreifen. so ein Beispiel findest Du hier:
https://www.excel-inside.de/vba-loesungen/datei/947-daten-aus-geschlossener-arbeitsmappe-auslesen
Ich würde allerdings beim Öffnen des Formulars die PLZ-DAtei per ADODB in
ein Recordset schreiben und dann per Recordset.FindFirst die zur PLZ passenden
Orte in einer Combobox anbieten. Das geht schnell und der User merkt garnicht
das ein Datenzugriff auf eine andere Datei erfolgt.
Gruß von Luschi
aus klein-Paris
PS: wenn Du die Formular- und die PLZ-Datei in Auszügen bereitstelltst, mache ich Dir ein Beispiel
Anzeige
AW: Daten aus geschlossener Datei einlesen
27.01.2018 15:30:00
Sepp
Hallo Rainer,
das sollte man halt gleich am Anfang mitteilen!
Da gibt es viele Möglichkeiten, z.B.
' **********************************************************************
' Modul: UserForm1 Typ: Userform
' **********************************************************************

Option Explicit

Private Sub TextBox1_Change()
Dim strWhere As Variant, strSelect As String, objADO As Object

If Len(TextBox1) = 5 Then
  strSelect = "[Ort]"
  strWhere = "WHERE PLZ=" & TextBox1
  Set objADO = ExcelTable("E:\Forum\Postleitzahlen.xlsx", "Tabelle1", "A1:B35000", strWhere, strSelect)
  If Not objADO Is Nothing Then
    If Not objADO.BOF Then TextBox2 = objADO.Fields(0).Value
  Else
    TextBox2 = ""
  End If
Else
  TextBox2 = ""
End If

Set objADO = Nothing
End Sub

Private Function ExcelTable(ByVal Path As String, ByVal Table As String, ByVal SourceRange As _
  String, Optional ByVal WhereString As String = "", Optional ByVal SelectString As String = "*") As Object

Dim SQL As String
Dim Con As String

On Error GoTo ErrorHandler
If ((GetAttr(Path) And vbDirectory) <> vbDirectory) Then
  SQL = "SELECT " & SelectString & " FROM [" & Table & "$" & SourceRange & "] " & WhereString
  If Mid(Path, InStrRev(Path, ".") + 1) = "xls" Then
    Con = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Extended Properties=Excel 8.0;" & "Data Source=" & _
      Path & ";"
  ElseIf Mid(Path, InStrRev(Path, ".") + 1) Like "xls?" Then
    Con = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Extended Properties=""Excel 12.0;HDR=YES"";" & _
      "Data Source=" & Path & ";"
  Else
    GoTo ErrorHandler
  End If
  Set ExcelTable = CreateObject("ADODB.Recordset")
  ExcelTable.Open SQL, Con, 3, 1
  Exit Function
End If
ErrorHandler:
Set ExcelTable = Nothing
End Function

Die Namen der Textboxen, den Dateipfad, den Tabellennamen und den Bereich, sowie die Spaltenüberschriften in der PLZ-Tabelle, musst du anpassen!
Gruß Sepp

Anzeige
AW: Daten aus geschlossener Datei einlesen
27.01.2018 18:05:08
Rainer
Super, vielen Dank, unglaublich es funktioniert. Größte Hochachtung an jeden, der diesen Code versteht.
Doch: Jeder Wunsch der in Erfüllung geht macht augenblicklich Junge!
Viele Gemeinden haben Teilorte. Noch genialer wäre es, wenn der Code auch noch die Teilorte in eine ComboBox laden würde. Die Teilorte sind in der selben Datei/Tabelle und in der selben Zeile wie die PLZ und die Gemeinde zu finden. Ortsteil1 findet sich in Spalte G, Ortsteil2 in Spalte H usw. Die Anzahl der Teilorte ist unterschiedlich. In der letzten benutzten Spalte der Zeile steht auch der letzte Teilort. Danach kommt nichts mehr.
Sicher gibt es auch hierzu eine geniale Lösung?
LG Rainer.
Anzeige
AW: Daten aus geschlossener Datei einlesen
27.01.2018 18:12:11
Sepp
Hallo Rainer,
fast alles geht, aber der Tabellenaufbau deine PLZ-Datei ist ungünstig!
Besser wäre es, wenn alle Orte/Ortsteile mit der PLZ in der Liste stehen würden, also zum Beispiel
5 mal die PLZ 12345 mit den jeweiligen Ortsteilen.
Kannst du deine PLZ-Datei hochladen?
Gruß Sepp

AW: Daten aus geschlossener Datei einlesen
27.01.2018 18:35:54
Rainer
Ja kann ich gerne machen.
https://www.herber.de/bbs/user/119322.xlsx
Allerdings ist die Sache mit den Teilorten noch eine Baustelle. Suche bitte die PLZ 79379. Dort hab ich mal begonnen Teilorte einzutragen.
LG Rainer
Anzeige
AW: Daten aus geschlossener Datei einlesen
27.01.2018 21:52:56
Sepp
Hallo Rainer,
nachdem mein Laptop zwischenzeitlich einen Streik eingelegt hat, hat es etwas länger gedauert.
Deine PLZ-Datei bleibt unverändert! In der angehängten Datei musst du den Pfad zur PLZ-Datei anpassen.
https://www.herber.de/bbs/user/119327.xlsm
Gruß Sepp

AW: Daten aus geschlossener Datei einlesen
27.01.2018 22:58:24
Rainer
Ganz herzlichen Dank für deine Mühe. Jetzt hab ich zwei Versionen, da ich in der Zwischenzeit selbst was gebastelt habe. Allerdings mit PLZ-Datei öffnen, PLZ suchen, Daten auslesen, in UserForm schreiben, PLZ-Datei wieder schließen.
Ich werde deine Version einrichten und anschließend testen welche der beiden schneller und stabiler läuft. Bericht folgt. Vielen Dank.
LG Rainer.
Anzeige
AW: Daten aus geschlossener Datei einlesen
27.01.2018 23:09:22
Rainer
Hallo Sepp,
ok, du hast gewonnen, was mich jedoch nicht wirklich überrascht. Deine Prozeduren sind wesentlich schneller. Ich staune. Herzlichen Dank nochmal und bis zum nächsten Problem.
LG Rainer.
AW: Daten aus geschlossener Datei einlesen
27.01.2018 23:24:43
Sepp
Hallo Rainer,
freut mich, dass es klappt.
Hier hätte ich noch eine Version mit Comboboxen anstelle der Textboxen man kann sowohl in 'PLZ' als auch in 'Ort' Eingaben machen.
https://www.herber.de/bbs/user/119332.xlsm
Gruß Sepp

Anzeige
AW: Daten aus geschlossener Datei einlesen
28.01.2018 14:30:45
Rainer
Guten Tag Sepp,
freut mich sehr, dass du dich nochmal gemeldet hast. Habe gestern Nacht nochmal dein Code studiert und musste kapitulieren. Ich habe zwar schon viele UserForms mit allem drum herum gebastelt und schöne Erfolge gefeiert aber hier bin ich an meine Grenze gestoßen. Ich würde aber gerne verstehen was da abläuft, auch um für andere Aufgaben, möglicherweise, wieder darauf zurückgreifen zu können.
Falls es für dich nicht zu Aufwendig ist und du mal Zeit hast, darf ich dich dann bitten mir eine kleine "Betriebsanleitung" für die Codes anzufertigen? Für mich ist VB, wenn auch nicht mehr als ein Hobby, immer wieder eine spannende Sache und möchte gerne mehr können und lernen.
Dein jüngster Code werde ich heute Abend ausprobieren. Auch dafür ganz herzlichen Dank.
Übrigens: falls du der Meinung bist, dass unserere Korrespondenz inzwischen den Rahmen des Forums hier sprengt kannst du mir gerne auch direkt an meine Mail-Adresse rhoeferlin@stepnet.de antworten.
LG Rainer.
Anzeige
AW: Daten aus geschlossener Datei einlesen
28.01.2018 16:15:02
Sepp
Hallo Rainer,
hier der Code it ein paar Kommentaren.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set objADO = Nothing
End Sub

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public objADO As Object

Public Sub initializeADO()
If objADO Is Nothing Then _
  Set objADO = ExcelTable("E:\Forum\Postleitzahlen.xlsx", "Postleitzahlen", "A1:L15000")
End Sub

Public Function ExcelTable(ByVal Path As String, ByVal Table As String, ByVal SourceRange As _
  String, Optional ByVal WhereString As String = "", Optional ByVal SelectString As String = "*") As Object

Dim SQL As String
Dim Con As String
'Liest Daten aus einer Excel-Tabelle mit Hilfe einer SQL-Abrage aus, die Tabelle muss dabei den Kriterien einer Dabtenbak
'entsprechen. Also eine Überschriftenzeile mit eintdeutigen Überschriften,
'keine leeren Zeilen und in jeder Spalte nur ein Datentyp.
On Error GoTo ErrorHandler
If ((GetAttr(Path) And vbDirectory) <> vbDirectory) Then
  SQL = "SELECT " & SelectString & " FROM [" & Table & "$" & SourceRange & "] " & WhereString
  If Mid(Path, InStrRev(Path, ".") + 1) = "xls" Then
    Con = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Extended Properties=Excel 8.0;" & "Data Source=" & _
      Path & ";"
  ElseIf Mid(Path, InStrRev(Path, ".") + 1) Like "xls?" Then
    Con = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Extended Properties=""Excel 12.0;HDR=YES"";" & _
      "Data Source=" & Path & ";"
  Else
    GoTo ErrorHandler
  End If
  Set ExcelTable = CreateObject("ADODB.Recordset")
  ExcelTable.Open SQL, Con, 3, 1
  Exit Function
End If
ErrorHandler:
Set ExcelTable = Nothing
End Function

Sub showForm()
UserForm1.Show
End Sub

' **********************************************************************
' Modul: UserForm1 Typ: Userform
' **********************************************************************

Option Explicit

Private bolAction As Boolean

Private Sub cboOrt_Change()
Dim lngI As Long
On Error Resume Next
'bolAction ist eine Hilfsvariable um mehrfachaufruf des Codes zu unterbinden
If Not bolAction Then Exit Sub
'bolAction auf Falsch setzen
bolAction = False
With cboTeil
  'Prüfen obj das ADO-Object exstiert
  If objADO Is Nothing Then Call initializeADO
  'Recordset des ADO-Objectes nach der PLZ filtern
  objADO.Filter = "Ort='" & cboOrt.Text & "'"
  If Not objADO.EOF Then
    'Combobox für die Ortsteile leeren
    .Clear
    For lngI = 2 To objADO.Fields.Count - 1
      'Wenn Ortsteile vorhanden, dann in Combobox schreiben
      If Not IsNull(objADO.Fields(lngI).Value) Then
        .AddItem objADO.Fields(lngI).Value
      End If
    Next
    'Wenn Einträge vorhanden, dann entsperren
    .Enabled = .ListCount > 0
    'Auf erste Zeile stellen
    If .Enabled Then .ListIndex = 0
  Else
    'Wenn keine Ortsteile vorhanden Combobox leeren und sperren
    .Clear
    .Enabled = False
  End If
End With
'Listindex der PLZ-Combobox auf den Ort einstellen, hier benötigen wir jetzt den Index der Ort-Combobox
cboPLZ.ListIndex = cboOrt
'Hilfsvariable auf Wahr stellen
bolAction = True
End Sub

Private Sub cboPLZ_Change()
Dim lngI As Long
On Error Resume Next
'bolAction ist eine Hilfsvariable um mehrfachaufruf des Codes zu unterbinden
If Not bolAction Then Exit Sub
'bolAction auf Falsch setzen
bolAction = False
With cboTeil
  'bolAction auf Falsch setzen
  If objADO Is Nothing Then Call initializeADO
  'Recordset des ADO-Objectes nach der Ort filtern, hier benötigen wir den Index!
  objADO.Filter = "PLZ=" & cboPLZ
  If Not objADO.EOF Then
    'Combobox für die Ortsteile leeren
    .Clear
    For lngI = 2 To objADO.Fields.Count - 1
      If Not IsNull(objADO.Fields(lngI).Value) Then
        'Wenn Ortsteile vorhanden, dann in Combobox schreiben
        .AddItem objADO.Fields(lngI).Value
      End If
    Next
    'Wenn Einträge vorhanden, dann entsperren
    .Enabled = .ListCount > 0
    'Auf erste Zeile stellen
    If .Enabled Then .ListIndex = 0
  Else
    'Wenn keine Ortsteile vorhanden Combobox leeren und sperren
    .Clear
    .Enabled = False
  End If
End With
'Value der Ort-Combobox auf den Ort einstellen, Value in Ort = Listindex in PLZ
cboOrt = cboPLZ.ListIndex
'Hilfsvariable auf Wahr stellen
bolAction = True
End Sub

Private Sub UserForm_Initialize()
Dim varList() As Variant, lngI As Long
On Error Resume Next
'Um nicht bei jeder Änderung in den Comboboxen die Daten neu einlesen zu müssen
'werden die Daten beim Aufruf des UF geladen.
Call initializeADO
'Zum ersten Datensatz wechseln
objADO.moveFirst
'Array für die Orte dimensionieren
Redim varList(objADO.RecordCount - 1)
'Datensätze durchaufen
Do Until objADO.EOF
  'Die PLZ sind in der Tabelle schon sortiert, daher können wir sie direkt einlesen
  cboPLZ.AddItem objADO.Fields("PLZ")
  'Die Orte werden in das Array gelesen und mit einem Index versehen, diesen brauchen wir
  'um später auf den richtigen Eintrag zugreifen zu können.
  varList(lngI) = objADO.Fields("Ort") & "_" & CStr(lngI)
  'Index inkrementieren
  lngI = lngI + 1
  'Zum nächsten Datensatz wechseln
  objADO.moveNext
Loop
'Array sortieren
Call QuickSort(varList)
With cboOrt
  'cboOrt hat zwei Spalten, die Erste enthält den Index, die zweite den Ort
  'In den Eigenschaften ist die Spaltenbreite der ersten Spalte auf 0 gestellt,
  'damit sie nicht angezeigt wird. Ebenfals in den Eigenschaften ist TextColumn auf 2 gestellt
  'damit der Text der zweiten Spalte angezeigt wird.
  'Array duchlaufen und Einträge der Combobox zuweisen
  For lngI = 0 To UBound(varList)
    'Index
    .AddItem Split(varList(lngI), "_")(1)
    'Ort
    .List(.ListCount - 1, 1) = Split(varList(lngI), "_")(0)
  Next
End With
cboTeil.Enabled = False
bolAction = True
End Sub

Private Sub UserForm_Terminate()
Set objADO = Nothing
End Sub

'Routine zum sortieren der Ortschaften
Private Sub QuickSort(data() As Variant, Optional UG, Optional OG)
Dim P1 As Long, P2 As Long, T1 As Variant, T2 As Variant

UG = IIf(IsMissing(UG), LBound(data), UG)
OG = IIf(IsMissing(OG), UBound(data), OG)

P1 = UG
P2 = OG
T1 = data((P1 + P2) / 2)

Do
Do While (data(P1) < T1): P1 = P1 + 1: Loop
Do While (data(P2) > T1): P2 = P2 - 1: Loop
  If P1 <= P2 Then
    T2 = data(P1): data(P1) = data(P2): data(P2) = T2
    P1 = P1 + 1: P2 = P2 - 1
  End If
Loop Until (P1 > P2)

If UG < P2 Then QuickSort data, UG, P2
If P1 < OG Then QuickSort data, P1, OG

End Sub

Gruß Sepp

Anzeige
AW: Daten aus geschlossener Datei einlesen
29.01.2018 15:17:12
Rainer
Puhh, jetzt hab ich ne Weile was zu tun. Vielen Dank. Machs gut.
LG Rainer.

221 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige