Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
376to380
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
376to380
376to380
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

DRINGEND: Datenimport via VBA?

DRINGEND: Datenimport via VBA?
10.02.2004 09:42:46
Doris
Hallo liebe Leute
Ihr seid meine letzte Hoffnung ;-) Ich stehe vor der Herausforderung, eine Feedbackauswertung zu machen. Das ist eigentlich nicht das Problem, denn ich habe solche Geschichten schon einige Male gemacht... jeweils mit 30-50 Feedbackbogen, ... jetzt jedoch gilt es 160 Bögen zu erfassen und wenn ich diese Anzahl Datensätze manuell in meine Excel-Tabelle einfüllen soll, bin ich Stunden mit copy-paste beschäftigt ;-)Vielleicht gibt es einen einfachen VBA-Trick?
Bei den Datenquellen handelt es sich um .txt-Dateien welche aus Word-Formularen generiert wurden. Als Trennzeichen ist ';' definiert. Diese Daten-Dateien sind Nummeriert.
Wie kriege ich jetzt möglichst automatisch '1.txt' in Spalte 'F', '2.txt' in Spalte 'G', etc?
Gruss, Doris

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: DRINGEND: Datenimport via VBA?
10.02.2004 09:52:38
sam
Hi,
kannst du einen txt uploaden, dann kann man sich mehr vorstellen.
Sam
AW: DRINGEND: Datenimport via VBA?
10.02.2004 10:18:18
Doris
Sam,
irgendwie klappt der Upload nicht! Ich den Inhalt zur Not aus einer Beispieldatei herauskopiert:

0;0;0;0;0;0;1;0;0;0;0;1;"the instruction on how to walk from the "Hirschen" back to the hotel";0;0;"";1;0;"";0;0;1;0;0;0;1;0;0;1;0;0;0;0;0;1;0;0;1;0;0;0;1;0;"";0;0;0;0;"As always some presentations and topics were better than others"

Ich hoffe, das hilft weiter?!
Gruss, Doris
AW: DRINGEND: Datenimport via VBA?
10.02.2004 10:49:10
Karl-Otto Reimann
Hallo Doris

Sub Dat_Imp()
Dim sWord As String, sPath As String, sSearchPath As String, FileName As String, InputData
Dim AnzFound As Integer
AnzFound = 0
sWord = ";"
sSearchPath = "c:\Pfad\DeinPfad\*.txt"
sPath = "c:\Pfad\DeinPfad\"
FileName = Dir(sSearchPath)
If FileName <> "" Then
Do While FileName <> ""
Open sPath & FileName For Input As #1
Do While Not EOF(1)
Line Input #1, InputData
If InStr(1, InputData, sWord) > 0 Then
AnzFound = AnzFound + 1
Sheets("Tabelle1").Cells(AnzFound + 1, 5) = InputData
End If
Loop
Close #1
FileName = Dir
Loop
End If
End Sub

Gruß
Karl-Otto
Anzeige
AW: DRINGEND: Datenimport via VBA?
10.02.2004 11:20:39
Doris
Hallo Karl-Otto
Danke für den Code. Ich habe ihn bei mir in ein neues Modul eingefügt, richtig? Da ich nur wenig Ahnung von VBA habe, brauche ich noch ein paar Infos, welche Code-Passagen ich manuell anpassen muss. Ich nehme an, überall dort wo Pfad verlangt ist, gebe ich den Pfad zu meine txts an?! Was muss ich sonst noch beachten, dass kein 'Laufzeitfehler '53'' resultiert?
Gruss, Doris
AW: DRINGEND: Datenimport via VBA?
10.02.2004 11:42:53
Doris
sorry, war mein Fehler... ich habe den letzten '\' beim Pfad vergessen ;-)
Und dann habe ich mich wohl noch unklar ausgedrückt... nochmals sorry! Wenn ich den Makro jetzt ausführe, werden alle Datensätze aus dem Ordner in die Mappe eingelesen und eingefügt. Und zwar jeder auf einer einzelnen Zeile aneinander mit Semikolon getrennt.
Was ich aber brauche ist:
Datei '1.txt' wird in Spalte 'F' eingefügt, dabei soll nach jedem ';' im txt-File eine neue Zeile genommen werden.
z.B.
txt1 sieht so aus:
0;0;0;0;1;0;"text";0;0;1;
txt2 sieht so aus:
1;0;0;0;1;0;"muster";1;0;0;

in Excel solls so daherkommen
Spalte F (=Datensatz '1.txt')
==========
Zeile 1: 0
Zeile 2: 0
Zeile 3: 0
Zeile 4: 0
Zeile 5: 1
Zeile 6: 0
Zeile 7: text
Zeile 8: 0
Zeile 9: 0
Zeile 10:1
Spalte G (=Datensatz '2.txt')
==========
Zeile 1: 1
Zeile 2: 0
Zeile 3: 0
Zeile 4: 0
Zeile 5: 0
Zeile 6: 0
Zeile 7: muster
Zeile 8: 1
Zeile 9: 0
Zeile 10:0
Alles klar? ;-)
Gruss, Doris
Anzeige
AW: so läuft es wenigstens
10.02.2004 21:22:47
Peter Feustel
Hallo Doris,
vielleicht nicht die eleganteste, aber eine laufende Lösung:


Sub Dat_Imp()
 Dim sWord As String, sPath As String, sSearchPath As String, FileName As String, InputData
 
 Dim Zeile      As Integer
 Dim Spalte     As Integer
 Dim Indx       As Integer
 Dim Zeichen    As String
 Dim Wert       As String
 
 
  sWord = ";"
  Spalte = 5
  sSearchPath = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Excel-Dateien\Text-Datei.txt"
  sPath = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Excel-Dateien\"
  FileName = Dir(sSearchPath)
  
  If FileName <> "" Then
    Do While FileName <> ""
       Open sPath & FileName For Input As #1
       Do While Not EOF(1)
          Line Input #1, InputData
          Wert = ""
          Zeile = 1
          Spalte = Spalte + 1
          For Indx = 1 To Len(InputData)
             Zeichen = Mid(InputData, Indx, 1)
             If Zeichen <> ";" Then
                Wert = Wert & Zeichen
              Else
                Sheets("Tabelle8").Cells(Zeile, Spalte) = Wert
                Zeile = Zeile + 1
                Wert = ""
             End If
          Next Indx
       Loop
       
       Close #1
       FileName = Dir
    Loop
  End If
  
End Sub

     Code eingefügt mit Syntaxhighlighter 2.5


Gruß, Peter
Anzeige
AW: vielleicht etwas eleganter
10.02.2004 21:37:22
Peter Feustel
Hallo Doris,
du musst natürlich Pfad und Tabellenblatt-Name (bei mir "Tabelle8") noch anpassen, aber es läuft und ist ein wenig eleganter als die erste Version.


Sub Dat_Imp()
 Dim sWord As String, sPath As String, sSearchPath As String, FileName As String, InputData
 
 Dim Zeile      As Integer
 Dim Spalte     As Integer
 Dim Indx       As Integer
  
  sWord = ";"
  Spalte = 5
  sSearchPath = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Excel-Dateien\Text-Datei.txt"
  sPath = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Excel-Dateien\"
  FileName = Dir(sSearchPath)
  
  If FileName <> "" Then
    Do While FileName <> ""
       Open sPath & FileName For Input As #1
       Do While Not EOF(1)
          Line Input #1, InputData
          Zeile = 1
          Spalte = Spalte + 1
          For Indx = 1 To Len(InputData)
             If Mid(InputData, Indx, 1) <> ";" Then
                Sheets("Tabelle8").Cells(Zeile, Spalte) = _
                Sheets("Tabelle8").Cells(Zeile, Spalte) & Mid(InputData, Indx, 1)
              Else
                Zeile = Zeile + 1
             End If
          Next Indx
       Loop
       
       Close #1
       FileName = Dir
    Loop
  End If
  
End Sub

     Code eingefügt mit Syntaxhighlighter 2.5


Gruß, Peter
Anzeige
AW: vielleicht etwas eleganter
11.02.2004 08:50:14
Doris
Herzlichen Dank, Peter, für den tollen Code... funktioniert!!!
Nur noch eine kleine Frage ;-)
Die Spalten 'F' bis 'GF' sind in Zeile 1 nummeriert, d.h. Spalte 'F' ist die Nr. 1, Spalte 'G' die Nr. 2, Spalte 'H' die Nr. 3, Spalte 'AN' die Nr. 35, etc. Die txt-files sind ebenfalls Nummeriert (z.B. '1.txt', '2.txt', '3.txt', '35.txt' etc.). Idealerweise wird nun die Datei '1.txt' in die Spalte 'F' gefüllt, '3.txt' in Spalte 'H', '35.txt' in Spalte 'AN', etc.
Meinst du, wir kriegen das gemeinsam hin? Wäre super-toll, echt!
Grüsse, Doris
AW: vielleicht etwas eleganter
11.02.2004 09:32:57
Peter Feustel
Guten Morgen Doris,
wenn du sicher bist, dass es in jeder Datei nur die Werte für eine Spalte gibt und die Dateinamen nicht größer als 251 werden (weil ja erst in der 6. Spalte begonnen wird), sollte es mit dem beigefügten Code laufen.


Sub Dat_Imp()
 Dim sWord As String, sPath As String, sSearchPath As String, FileName As String, InputData
 
 Dim Zeile      As Integer
 Dim Spalte     As Integer
 Dim Indx       As Integer
 Dim Nummer     As String
  
  sWord = ";"
  Spalte = 5
  sSearchPath = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Excel-Dateien\1.txt"
  sPath = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Excel-Dateien\"
  FileName = Dir(sSearchPath)
  
  If FileName <> "" Then
    Do While FileName <> ""
       Open sPath & FileName For Input As #1
       Nummer = ""
       For Indx = 1 To Len(FileName)                  ' aus dem Datei-Namen die Nummer holen
          If Mid(FileName, Indx, 1) <> "." Then       ' kein Punkt gefunden ?
             Nummer = Nummer & Mid(FileName, Indx, 1) ' Nummer entnehmen - 1 bis mehrstellig
           Else                                       ' sonst
             Exit For                                 ' Nummer fertig übernommen
          End If
       Next Indx
       Spalte = CInt(Nummer) + 5                      ' bei Spalte "F" mit 1.txt beginnen
       Do While Not EOF(1)
          Line Input #1, InputData
          Zeile = 1
          For Indx = 1 To Len(InputData)
             If Mid(InputData, Indx, 1) <> ";" Then
                Sheets("Tabelle8").Cells(Zeile, Spalte) = _
                Sheets("Tabelle8").Cells(Zeile, Spalte) & Mid(InputData, Indx, 1)
              Else
                Zeile = Zeile + 1
             End If
          Next Indx
       Loop
       
       Close #1
       FileName = Dir
    Loop
  End If
  
End Sub

     Code eingefügt mit Syntaxhighlighter 2.5


Gruß, Peter
Anzeige
AW: vielleicht etwas eleganter
11.02.2004 10:11:22
Doris
Lieber Peter
Jetzt wird nur noch Datensatz '1.txt' (in Spalte 'F', hurra!) geladen... es liegen aber z.Zt. ca. 20 txts im definierten Ordner
Kannst du dir das erklären?
Grüsse Doris
AW: vielleicht etwas eleganter
11.02.2004 10:35:46
Peter Feustel
Hallo Doris,
wahrscheinlich, weil in sSearchPath die Datei 1.txt angegeben wird, kann das sein?
Gruß, Peter
AW: vielleicht etwas eleganter
11.02.2004 10:45:59
Peter Feustel
Hallo Doris,
ich habe mir einen Ordner 'Doris' angelegt, dort zwei .txt-Dateien 1.txt und 15.txt hineingebracht - und es läuft einwandfrei.
Hier mein Code:


Sub Dat_Imp()
 Dim sWord As String, sPath As String, sSearchPath As String, FileName As String, InputData
 
 Dim Zeile      As Integer
 Dim Spalte     As Integer
 Dim Indx       As Integer
 Dim Nummer     As String
  
  sWord = ";"
  Spalte = 5
  sSearchPath = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Doris\*.txt"
  sPath = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Doris\"
  FileName = Dir(sSearchPath)
  
  If FileName <> "" Then
    Do While FileName <> ""
       Open sPath & FileName For Input As #1
       Nummer = ""
       For Indx = 1 To Len(FileName)                  ' aus dem Datei-Namen die Nummer holen
          If Mid(FileName, Indx, 1) <> "." Then       ' kein Punkt gefunden ?
             Nummer = Nummer & Mid(FileName, Indx, 1) ' Nummer entnehmen - 1 bis mehrstellig
           Else                                       ' sonst
             Exit For                                 ' Nummer fertig übernommen
          End If
       Next Indx
       Spalte = CInt(Nummer) + 5                      ' bei Spalte "F" mit 1.txt beginnen
       Do While Not EOF(1)
          Line Input #1, InputData
          Zeile = 1
          For Indx = 1 To Len(InputData)
             If Mid(InputData, Indx, 1) <> ";" Then
                Sheets("Tabelle8").Cells(Zeile, Spalte) = _
                Sheets("Tabelle8").Cells(Zeile, Spalte) & Mid(InputData, Indx, 1)
              Else
                Zeile = Zeile + 1
             End If
          Next Indx
       Loop
       
       Close #1
       FileName = Dir
    Loop
  End If
  
End Sub

     Code eingefügt mit Syntaxhighlighter 2.5

Gruß, Peter
Anzeige
AW: vielleicht etwas eleganter
11.02.2004 14:20:01
Peter Feustel
Hallo Doris,
meine letzte Version, mit ein paar Abfragen die Sicherheit der Dateinamen betreffend und einem Zwischenfeld für die Werte zwischen den Semikolon, so kann man jederzeit wiederholen, ohne die Zellen verfielfacht zu bekommen.


Sub Dat_Imp()
 Dim sWord        As String                ' das Trennzeichen - hier das Semikolon
 Dim sPath        As String
 Dim sSearchPath  As String
 Dim FileName     As String                ' Datei-Name
 Dim InputData    As String                ' Datei-Inhalt
 
 Dim Zeile        As Integer               ' Zeile in die eingefügt wird
 Dim Spalte       As Integer               ' Spalte in die eingefügt wird
 Dim Indx         As Integer               ' For/Next Index
 Dim Nummer       As String                ' Nummer aus Dateinamen
 Dim Inhalt       As String                ' Feldinhalt zwischen den Semikolon
  
  sWord = ";"                              ' Trennzeichen ist das Semikolon
  
  sSearchPath = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Doris\*.txt"
  sPath = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Doris\"
  FileName = Dir(sSearchPath)
  
  If FileName <> "" Then                              ' Dateiname nicht Spaces ?
    Do While FileName <> ""                           ' bis keine Datei mehr im Ordner ist
       Open sPath & FileName For Input As #1          ' Datei öffnen
       Nummer = ""                                    ' Nummer für Spalte löschen
       For Indx = 1 To Len(FileName)                  ' aus dem Datei-Namen die Nummer holen
          If Mid(FileName, Indx, 1) <> "." Then       ' kein Punkt gefunden ?
             Nummer = Nummer & Mid(FileName, Indx, 1) ' Nummer entnehmen - 1 bis mehrstellig
           Else                                       ' sonst
             Exit For                                 ' Nummer fertig übernommen
          End If
       Next Indx                                      ' nächstes Zeichen vor .xls ermitteln
       If IsNumeric(Nummer) Then                      ' ist der Dateiname nummerisch ?
          Spalte = CInt(Nummer) + 5                   ' bei Spalte "F" mit 1.txt beginnen
        Else
          MsgBox "es gibt eine Datei,die heißt > " & FileName & " <" & vbCrLf & vbCrLf _
               & "nicht nummerische Namen darf es nicht geben, bitte korrigieren Sie" & vbCrLf _
               & "den Dateinamen und starten dann das Makro erneut." _
               , 64, "Fehler im Dateinamen"
          Close #1
          Exit Sub                                    ' Makro verlassen
       End If
       If Spalte > 256 Then                           ' prüfen der Spalte max 256
          MsgBox "es gibt eine Datei mit der Nummer > " & FileName & " <" & vbCrLf & vbCrLf _
               & "mehr als 256 Spalten gibt es nicht, bitte korrigieren Sie" & vbCrLf _
               & "den Dateinamen und starten dann das Makro erneut." _
               , 64, "Fehler im Dateinamen"
          Close #1
          Exit Sub                                    ' Makro verlassen
       End If
       If Right(InputData, 1) <> ";" Then             ' endet der String nicht mit Semikolon ?
          InputData = InputData & ";"                 ' dann Semikolon einfügen
       End If
       Do While Not EOF(1)                            ' solange nicht EOF ist
          Line Input #1, InputData                    ' Zeile einlesen
          Zeile = 1                                   ' Zeile Tabellenblatt auf 1 setzen
          For Indx = 1 To Len(InputData)              ' von 1 bis Ende Eingabe
             If Mid(InputData, Indx, 1) <> ";" Then   ' kein Semikolon gefunden ?
                Inhalt = Inhalt & Mid(InputData, Indx, 1) ' Inhalt zwischen den Semikolon holen
              Else
                Sheets("Tabelle8").Cells(Zeile, Spalte) = Inhalt ' Inhalt an Spalte übertragen
                Inhalt = ""                           ' alten (letzten) Inhalt löschen
                Zeile = Zeile + 1                     ' nächste Zeile ermitteln
             End If
          Next Indx                                   ' nächstes Zeichen holen
       Loop                                           ' nächste Datei holen
       
       Close #1                                       ' Datei schließen
       FileName = Dir                                 ' nächste Datei holen
    Loop
  End If
  
End Sub

     Code eingefügt mit Syntaxhighlighter 2.5

Gruß, Peter
Anzeige
AW: vielleicht etwas eleganter
11.02.2004 16:10:24
Doris
Lieber Peter
Du bist echt super!!! Funktioniert jetzt alles wunderbar... die vergangenen paar Stunden lag bei uns der Server brach. Ich hoffte bloss, dass mein VBA nicht schuld daran ist :-)
Ganz herzlichen Dank für die tolle Unterstützung!
Gruss, Doris
AW: danke für die Antwort
11.02.2004 17:39:36
Peter Feustel
Hallo Doris,
hier meine neueste Version, sie übernimmt aus nnn.txt auch mehrere Zeilen, falls vorhanden. Ist eigentlich immer gewährleistet, dass die Zeilen mit einem Semikolon enden?
Wenn nicht, fehlt der letzte Wert!


Sub Datei_Import()
 Dim sWord        As String                ' das Trennzeichen - hier das Semikolon
 Dim sPath        As String
 Dim sSearchPath  As String
 Dim FileName     As String                ' Datei-Name
 Dim InputData    As String                ' Datei-Inhalt
 
 Dim Zeile        As Integer               ' Zeile in die eingefügt wird
 Dim Spalte       As Integer               ' Spalte in die eingefügt wird
 Dim Indx         As Integer               ' For/Next Index
 Dim Nummer       As String                ' Nummer aus Dateinamen
 Dim Inhalt       As String                ' Feldinhalt zwischen den Semikolon
   
  sWord = ";"                              ' Trennzeichen ist das Semikolon
  
  sSearchPath = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Doris\*.txt"
  sPath = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Doris\"
  FileName = Dir(sSearchPath)
  
  If FileName <> "" Then                              ' Dateiname nicht Spaces ?
    Do While FileName <> ""                           ' bis keine Datei mehr im Ordner ist
       Open sPath & FileName For Input As #1          ' Datei öffnen
       Nummer = ""                                    ' Nummer für die Spalte löschen
       For Indx = 1 To Len(FileName)                  ' aus dem Datei-Namen die Nummer holen
          If Mid(FileName, Indx, 1) <> "." Then       ' kein Punkt gefunden ?
             Nummer = Nummer & Mid(FileName, Indx, 1) ' Nummer entnehmen - 1 bis mehrstellig
           Else                                       ' sonst
             Exit For                                 ' Nummer fertig übernommen
          End If
       Next Indx                                      ' nächstes Zeichen vor .xls ermitteln
       If IsNumeric(Nummer) Then                      ' ist der Dateiname nummerisch ?
          Spalte = CInt(Nummer) + 5                   ' bei Spalte "F" mit 1.txt beginnen
        Else
          MsgBox "es gibt eine Datei, die heißt > " & FileName & " <" & vbCrLf & vbCrLf _
               & "nicht nummerische Namen darf es nicht geben, bitte korrigieren" & vbCrLf _
               & "Sie den Dateinamen und starten dann das Makro erneut." _
               , 64, "Fehler im Dateinamen."
          Close #1                                    ' fehlerhafte Datei schließen
          Exit Sub                                    ' Makro verlassen
       End If
       If Spalte > 256 Then                           ' prüfen der Spalte auf max. 256
          MsgBox "es gibt eine Datei mit der Nummer > " & FileName & " <" & vbCrLf & vbCrLf _
               & "mehr als 256 Spalten gibt es nicht, bitte korrigieren" & vbCrLf _
               & "Sie den Dateinamen auf eine Nummer kleiner/gleich 251" & vbCrLf _
               & "und starten dann das Makro erneut." _
               , 64, "Fehler im Dateinamen."
          Close #1                                    ' fehlerhafte Datei schließen
          Exit Sub                                    ' Makro verlassen
       End If
       Zeile = 1                                      ' Zeile Tabellenblatt auf 1 setzen
       Do While Not EOF(1)                            ' solange nicht EOF ist
          Line Input #1, InputData                    ' Zeile einlesen
          For Indx = 1 To Len(InputData)              ' von 1 bis Ende Eingabe-Zeile
             If Mid(InputData, Indx, 1) <> ";" Then   ' noch kein Semikolon gefunden ?
                Inhalt = Inhalt & Mid(InputData, Indx, 1) ' Inhalt zwischen den Semikolon holen
              Else
                Sheets("Tabelle3").Cells(Zeile, Spalte) = Inhalt ' Inhalt an Spalte übertragen
                Inhalt = ""                           ' alten (letzten) Inhalt löschen
                Zeile = Zeile + 1                     ' nächste Zeile ermitteln
             End If
          Next Indx                                   ' nächstes Zeichen holen
       Loop                                           ' nächste Daten-Zeile holen
              
       Close #1                                       ' Datei schließen
       FileName = Dir                                 ' nächste Datei holen
    Loop
  End If
  

     Code eingefügt mit Syntaxhighlighter 2.5

Gruß, Peter
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige