Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1144to1148
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
Inhaltsverzeichnis

Datensätze einlesen

Datensätze einlesen
asz
Hallo,
stehe mal wieder vor einem Problem, für das ich trotz wiederholter Versuche noch keine Lösung gefunden habe - vielleicht habt Ihr eine Idee:
Ich möchte Datensätze der unten folgenden Form aus einer txt in Excel einlesen (als csv hab ichs leider nicht), aber so, dass die Werte (und auch nur die Werte) in Spalten stehen und nicht in Zeilen (TI, AU etc. sind die Feldkennzeichen). 'Text in Spalten' etc. hilft da nicht viel. Ein Makro?
Es wäre toll, wenn Ihr, das beste Excel-Forum überhaupt, mir helfen könntet,
herzlichen Dank im voraus
ASZ
Record: 1
TI- !Xun
AU- König, Christa
ED- Dimmendaal, Gerrit J. (ed. and introd.)
BK- Coding Participant Marking: Construction Types in Twelve African
Languages
PD- 2009
PG- xv, 389 pp.
SP- 23
EP- 53
PB- Benjamins, Amsterdam, Netherlands
NT- English summary.
IB- 9789027205773 (hbk.)
SE- Studies in Language Companion Series (SLCS): 110
SI- 0165-7763
SI- 0165-7763
SL- Kung language
SL- Ju/'hoan Kung dialect
LN- syntax
LN- and morphology
SU- relationship to participant role
PT- book article
LA- English
UD- 200904
SQ- 2009-3-9598
AN- 2009931393
UR-
http://search.ebscohost.com/login.aspx?direct=true&db=mzh&AN=2009931393
&loginpage=login.asp&site=ehost-live
UR-
http://search.ebscohost.com/login.aspx?direct=true&db=mzh&AN=2009931393
&loginpage=login.asp&site=ehost-live
-----------------------------------------------------------------------
-
Record: 2
TI- (A)genda Trouble and the Lot Complex: Older Men-Younger Women
Relationships in Trollope
AU- Polhemus, Robert M.
ED- Markwick, Margaret (ed. and introd.)
ED- Morse, Deborah Denenholz (ed. and introd.)
ED- Gagnier, Regenia (ed.)
BK- The Politics of Gender in Anthony Trollope's Novels: New Readings
for the Twenty-First Century
PD- 2009
PG- xiv, 259 pp.
SP- 11
EP- 29
PB- Ashgate, Surrey, England
IB- 9780754663898
SE- Nineteenth Century Series (NiCS)
LT- English literature
TM- 1800-1899
AS- Trollope, Anthony (1815-1882)
GD- fiction
SU- treatment of older man-younger woman relations
SU- relationship to Field, Kate (1838-1896)
SU- biographical approach
PT- book article
LA- English
UD- 200903
SQ- 2009-1-5434
AN- 2009580912
UR-
http://search.ebscohost.com/login.aspx?direct=true&db=mzh&AN=2009580912
&loginpage=login.asp&site=ehost-live
UR-
http://search.ebscohost.com/login.aspx?direct=true&db=mzh&AN=2009580912
&loginpage=login.asp&site=ehost-live
-----------------------------------------------------------------------
-
Record: 3
TI- (Dis)Empowering Paralympic Histories: Absent Athletes and Disabling
Discourses
AU- Peers, Danielle
SO- Disability & Society
JA- Disability & Society
PD- 2009 Aug
VI- 24
IP- 5
SP- 653
EP- 665
NT- English summary.
IS- 0968-7599
GT- rhetoric and composition
GT- discourse studies
SU- on history
SU- of Paralympics
SU- relationship to disabled athletes
SU- tragedy
SU- empowerment
PT- journal article
LA- English
UD- 200905
SQ- 2009-4-9842
AN- 2009301587
UR-
http://search.ebscohost.com/login.aspx?direct=true&db=mzh&AN=2009301587
&loginpage=login.asp&site=ehost-live
UR-
http://search.ebscohost.com/login.aspx?direct=true&db=mzh&AN=2009301587
&loginpage=login.asp&site=ehost-live
AW: Datensätze einlesen
09.03.2010 14:43:59
Rudi
Hallo,
(TI, AU etc. sind die Feldkennzeichen). 

Wie sollen die mehrfach vorhandenen behandelt werden, z.B SU in Rec.3?
Gruß
Rudi
AW: Datensätze einlesen
09.03.2010 15:09:34
asz
Hallo,
je nachdem was einfacher geht! :-) Es wäre ok, wenn die Inhalte jeweils in einer Spalte zusammengespielt werden, der Trennbedarf ist v.a. bei unterschiedlichen Spaltennamen da.
Ganz herzlichen Dank für Deine Mühe!!
ASZ
AW: Datensätze einlesen
09.03.2010 15:13:00
Rudi
Hallo,
in ein Modul:
Sub ttt()
Dim arrFields, sDaten, arrDaten(), arrtmp, i As Long, n, iCol As Integer
arrFields = Array("TI", "AU", "ED", "BK", "PD", "PG", "SP", "EP", "PB", "NT", _
"IB", "SE", "SI", "SL", "LN", "SU", "PT", "LA", "UD", "SQ", "AN", "UR", _
"LT", "TM", "AS", "GD", "SO", "JA", "VI", "IP", "IS", "GT")
Open "c:\test\asz.txt" For Input As #1  'Dateinamen anpassen
sDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
n = 1
ReDim arrDaten(1 To UBound(arrFields) + 1, 1 To UBound(sDaten))
For i = 0 To UBound(arrFields)
arrDaten(i + 1, n) = arrFields(i)
Next
For i = 0 To UBound(sDaten)
If sDaten(i) Like "Record*" Then
n = n + 1
End If
If Mid(sDaten(i), 3, 2) = "- " Then
iCol = Application.Match(Left(sDaten(i), 2), arrFields, 0)
arrDaten(iCol, n) = arrDaten(iCol, n) & Trim(Mid(sDaten(i), 4)) & "/"
End If
Next
ReDim Preserve arrDaten(1 To UBound(arrDaten), 1 To n)
arrDaten = WorksheetFunction.Transpose(arrDaten)
With Sheets(2)
.Cells.Clear
.Cells(1, 1).Resize(n, UBound(arrDaten, 2)) = arrDaten
.Cells.VerticalAlignment = xlTop
.Cells.WrapText = True
.Rows.AutoFit
End With
End Sub

Gruß
Rudi
Anzeige
AW: Datensätze einlesen
09.03.2010 15:26:24
asz
Hallo,
Wahnsinn, dass Du Dir so viel Arbeit machst - ganz herzlichen Dank!!!!!!
Leider bekomme ich die Fehlermeldung 'Typen unverträglich' zur Zeile
iCol = Application.Match(Left(sDaten(i), 2), arrFields, 0)
Was soll ich tun?
Nochmal dankeschön!!
ASZ
AW: Datensätze einlesen
09.03.2010 15:55:37
Rudi
Hallo,
ich kenne ja deine Daten nicht.
Möglicherweise gibt es noch ein Feld, dass in arrFields nicht enthalten ist.
Prüfe mal den Inhalt von sDaten(i) (Bei Fehler auf Debuggen klicken und dann mit der Maus auf den Ausdruck oder im Direktfenster ?sdaten(i) eingeben.
Mit dem Datenschnipsel, den du gepostet hast, klappt es.
Gruß
Rudi
Anzeige
AW: Datensätze einlesen
09.03.2010 16:37:37
asz
Hallo,
danke! Wenn ich mit der Maus draufgehe, zeigt er an
sDaten(I) = "RV- Yes"
Weiß leider nicht, was das heißt. Aber die Begründung, dass es noch weitere Feldnamen gibt, die nicht in arrFields sind, ist sehr wahrscheinlich. Das Problem ist, dass ich sie nicht alle kenne - und sie bei 20.000 Datensätzen zusammenzusammeln geht auch schlecht. Gibt es irgendeine Möglichkeit, dass das Makro weitere einfach ignoriert und nicht einliest?
Herzlichen Dank noch einmal?
ASZ
unbekannte Teile überlesen
09.03.2010 17:08:01
Erich
Hallo Andre,
das könnte so funzen:

Option Explicit
Sub ttt()
Dim arrFields, sDaten, arrDaten(), arrtmp, i As Long, n, vCol, iCol As Integer
arrFields = Array("TI", "AU", "ED", "BK", "PD", "PG", "SP", "EP", "PB", "NT", _
"IB", "SE", "SI", "SL", "LN", "SU", "PT", "LA", "UD", "SQ", "AN", "UR", _
"LT", "TM", "AS", "GD", "SO", "JA", "VI", "IP", "IS", "GT")
Open "c:\test\asz.txt" For Input As #1  'Dateinamen anpassen
sDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
n = 1
ReDim arrDaten(1 To UBound(arrFields) + 1, 1 To UBound(sDaten))
For i = 0 To UBound(arrFields)
arrDaten(i + 1, n) = arrFields(i)
Next
For i = 0 To UBound(sDaten)
If sDaten(i) Like "Record*" Then
n = n + 1
End If
If Mid(sDaten(i), 3, 2) = "- " Then
vCol = Application.Match(Left(sDaten(i), 2), arrFields, 0)
If IsNumeric(vCol) Then
iCol = vCol
arrDaten(iCol, n) = arrDaten(iCol, n) & Trim(Mid(sDaten(i), 4)) & "/"
'Else
' Stop ' nur zum Testen
End If
End If
Next
ReDim Preserve arrDaten(1 To UBound(arrDaten), 1 To n)
arrDaten = WorksheetFunction.Transpose(arrDaten)
With Sheets(2)
.Cells.Clear
.Cells(1, 1).Resize(n, UBound(arrDaten, 2)) = arrDaten
.Cells.VerticalAlignment = xlTop
.Cells.WrapText = True
.Rows.AutoFit
End With
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: unbekannte Teile überlesen
10.03.2010 11:47:19
asz
DANKE!!!! aber bitte siehe Antwort im Rudi-Thread an Euch beide!
Viele Grüße
ASZ
Optimierung
10.03.2010 09:42:15
Rudi
Hallo,
Sub asz()
Dim arrFields, sDaten, arrDaten(), arrtmp, i As Long, j As Integer, n, iCol As Integer
Dim oFields As Object
Open "c:\test\asz.txt" For Input As #1  'Dateinamen anpassen
sDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
'alle Feldnamen bestimmen
Set oFields = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(sDaten)
If Mid(sDaten(i), 3, 2) = "- " Then
If Not oFields.exists(Left(sDaten(i), 2)) Then oFields.Add Left(sDaten(i), 2), ""
End If
Next
arrFields = oFields.Keys
'Überschriften
n = 1
ReDim arrDaten(1 To UBound(arrFields) + 1, 1 To UBound(sDaten))
For i = 0 To UBound(arrFields)
arrDaten(i + 1, n) = arrFields(i)
Next
'Daten
For i = 0 To UBound(sDaten)
If sDaten(i) Like "Record*" Then n = n + 1
If Mid(sDaten(i), 3, 2) = "- " Then
iCol = Application.Match(Left(sDaten(i), 2), arrFields, 0)
arrDaten(iCol, n) = arrDaten(iCol, n) & Trim(Mid(sDaten(i), 4)) & "/ "
End If
Next
ReDim Preserve arrDaten(1 To UBound(arrDaten), 1 To n)
' letzen / raus
For i = 1 To n
For j = 1 To UBound(arrDaten)
If Right(arrDaten(j, i), 2) = "/ " Then
arrDaten(j, i) = Left(arrDaten(j, i), Len(arrDaten(j, i)) - 2)
End If
Next
Next
'Daten in Tabelle schreiben
arrDaten = WorksheetFunction.Transpose(arrDaten)
With Workbooks.Add.Sheets(1)
.Cells.Clear
.Cells(1, 1).Resize(n, UBound(arrDaten, 2)) = arrDaten
.Cells.VerticalAlignment = xlTop
.Cells.WrapText = True
.Rows.AutoFit
End With
End Sub

Gruß
Rudi
Anzeige
AW: Optimierung
10.03.2010 11:43:05
asz
Hallo Ihr beiden,
micht haut es immer wieder um, wie hilfsbereit Ihr seid! DANKE!!! - Leider bekomme ich bei beiden Lösung die Fehlermeldung:
Laufzeitfehler 1004
Die Transpose-Eigenschaft des WorksheetFunction-Objektes kann nicht zugeordnet werden.
Was tun?
Danke danke danke
ASZ
AW: Optimierung
10.03.2010 12:06:25
Rudi
hallo,
dann hast du anscheinend mehr als 65536 Datensätze. Dann kann man nicht mehr transponieren.
Also alles 'von Hand' umschaufeln.
Sub asz()
Dim arrFields, sDaten, arrDaten(), arrtmp, i As Long, j As Integer, n, iCol As Integer
Dim oFields As Object
Open "c:\test\asz.txt" For Input As #1  'Dateinamen anpassen
sDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
'alle Feldnamen bestimmen
Set oFields = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(sDaten)
If Mid(sDaten(i), 3, 2) = "- " Then
If Not oFields.exists(Left(sDaten(i), 2)) Then oFields.Add Left(sDaten(i), 2), ""
End If
Next
arrFields = oFields.Keys
'Überschriften
n = 1
ReDim arrDaten(1 To UBound(arrFields) + 1, 1 To UBound(sDaten))
For i = 0 To UBound(arrFields)
arrDaten(i + 1, n) = arrFields(i)
Next
'Daten
For i = 0 To UBound(sDaten)
If sDaten(i) Like "Record*" Then n = n + 1
If Mid(sDaten(i), 3, 2) = "- " Then
iCol = Application.Match(Left(sDaten(i), 2), arrFields, 0)
arrDaten(iCol, n) = arrDaten(iCol, n) & Trim(Mid(sDaten(i), 4)) & "/ "
End If
Next
ReDim Preserve arrDaten(1 To UBound(arrDaten), 1 To n)
' letzen / raus
For i = 1 To n
For j = 1 To UBound(arrDaten)
If Right(arrDaten(j, i), 2) = "/ " Then
arrDaten(j, i) = Left(arrDaten(j, i), Len(arrDaten(j, i)) - 2)
End If
Next
Next
'Daten in Tabelle schreiben
arrtmp = arrDaten
ReDim arrDaten(1 To n, 1 To oFields.Count)
For i = 1 To UBound(arrtmp, 2)
For j = 1 To UBound(arrtmp)
arrDaten(i, j) = arrtmp(j, i)
Next j
Next i
With Workbooks.Add.Sheets(1)
.Cells.Clear
.Cells(1, 1).Resize(n, UBound(arrDaten, 2)) = arrDaten
.Cells.VerticalAlignment = xlTop
.Cells.WrapText = True
.Rows.AutoFit
End With
End Sub

Gruß
Rudi
Anzeige
AW: Optimierung
10.03.2010 12:16:13
asz
Hallo Rudi,
danke!! - wahrscheinlich nerve ich mittlerweile tierisch, aber diesmal bekomme ich die Meldung:
Laufzeitfehler 1004: Anwendungs- oder objektorientierter Fehler
mit Highlighting der Zeile
.Cells(1, 1).Resize(n, UBound(arrDaten, 2)) = arrDaten
Was kann man da tun?
Sorry & nochmal viele vielen Dank
ASZ
hast du überhaupt 2007? owT
10.03.2010 12:40:15
Rudi
AW: Optimierung
10.03.2010 13:49:47
asz
Jaja, schon (gebe zu, hatte xls geöffnet, habe jetzt aber alles in xlsm umgeschaufelt, und der Effekt ist derselbe!). Hmmm?
Sorry
ASZ
AW: Optimierung
10.03.2010 13:58:50
Rudi
keine Ahnung. Kenne deine Daten nicht.
welche Dimensionen hat arrDaten?
Gruß
Rudi
AW: Optimierung
10.03.2010 14:16:15
asz
Habe jetzt einmal eine Probedatei mit 100 Datensätzen (größer ging nicht) hochgeladen:
https://www.herber.de/bbs/user/68496.txt
Insgesamt habe ich 20.000 Datensätze (gesplittet auf 20 Dateien).
Tut mir leid wg des Troubles
Danke!!!
ASZ
Anzeige
neuer Record nicht erkannt
10.03.2010 14:35:06
Rudi
Hallo,
in der neuen Datei sind vor Record 1 etc Leerzeichen.
Sub asz()
Dim arrFields, sDaten, arrDaten(), arrtmp, i As Long, j As Integer, n, iCol As Integer
Dim oFields As Object
Const sDelim As String = vbLf
Open "c:\test\asz.txt" For Input As #1  'Dateinamen anpassen
sDaten = Input(LOF(1), 1)
sDaten = Split(sDaten, vbCrLf)
Close #1
'alle Feldnamen bestimmen
Set oFields = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(sDaten)
If Mid(sDaten(i), 3, 2) = "- " Then
If Not oFields.exists(Left(sDaten(i), 2)) Then oFields.Add Left(sDaten(i), 2), ""
End If
Next
arrFields = oFields.Keys
'Überschriften
n = 1
ReDim arrDaten(1 To UBound(arrFields) + 1, 1 To UBound(sDaten))
For i = 0 To UBound(arrFields)
arrDaten(i + 1, n) = arrFields(i)
Next
'Daten
For i = 0 To UBound(sDaten)
If Left(Trim(sDaten(i)), 6) = "Record" Then n = n + 1
If Mid(sDaten(i), 3, 2) = "- " Then
iCol = Application.Match(Left(sDaten(i), 2), arrFields, 0)
arrDaten(iCol, n) = arrDaten(iCol, n) & Trim(Mid(sDaten(i), 4)) & sDelim
End If
Next
ReDim Preserve arrDaten(1 To UBound(arrDaten), 1 To n)
' letzes Trennzeichen raus
For i = 1 To n
For j = 1 To UBound(arrDaten)
If Right(arrDaten(j, i), 2) = sDelim Then
arrDaten(j, i) = Left(arrDaten(j, i), Len(arrDaten(j, i)) - Len(sDelim))
End If
Next
Next
'Daten in Tabelle schreiben
arrtmp = arrDaten
ReDim arrDaten(1 To n, 1 To oFields.Count)
For i = 1 To UBound(arrtmp, 2)
For j = 1 To UBound(arrtmp)
arrDaten(i, j) = arrtmp(j, i)
Next j
Next i
With Workbooks.Add.Sheets(1)
.Cells.Clear
.Cells(1, 1).Resize(n, UBound(arrDaten, 2)) = arrDaten
.Cells.VerticalAlignment = xlTop
.Cells.WrapText = True
.Rows.AutoFit
End With
End Sub

Gruß
Rudi
Anzeige
AW: neuer Record nicht erkannt
10.03.2010 16:00:33
asz
RUUUUUUUUUUUUUUUUUUUUUUUDI!!! (Stell Dir einen Stadionchor vor)
Hat geklappt - ganz ganz herzlichen Dank für Deine Hilfe und Deine Geduld!
Und ein Hoch auf Herbers Excel-Forum!
ASZ

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige