PDA

Vollständige Version anzeigen : Spalten anhand von Überschriften zu ordnen und Daten einlesen


m2r
10.03.2009, 10:42
Hallo Excel-Gemeinde,

ich habe mal wieder ein Problem, bei dem ich Eure Hilfe benötige.

Problem / Was ich möchte:
Ich habe eine Master Datei (siehe Anhang) in die ich gerne unterschiedliche CSV bzw. TXT Dateien importieren möchte. Alle Dateien sind fast gleich aufgebaut. Es gibt einen Überschriftenbereich und an einer bestimmten Stelle fangen die jeweiligen Daten an.
Ich würde jetzt gerne per Schaltfläche eine Routine öffnen in der ich eine Datei (Import-Datei) auswählen kann. Dann sollen die Überschriften der Master-Datei mit den Überschriften der Import-Datei verglichen werden und in die Master-Datei eingeleseb werden. Bei der Import-Datei sind nicht immer aller Überschriften vorhanden, so dass eine Zuordnung der Daten durch die Überschriften erfolgen sollte.

Ich hoffe ich habe mich verständlich genau ausgedrückt.

Gruß m2r

System: Windows XP mit allen SP und Excel 2003 bzw. 2007 ebenfalls mit allen SP

m2r
11.03.2009, 11:07
Hi,

als das mit dem Datei öffnen habe ich jetzt bin bekommen. Leider stehe ich beim Abgleich der Überschriften bzw. Spalten auf einem Schlauch. Kann mir da vielleicht jemand auf die Sprünge helfen.

Gruß m2r

jinx
11.03.2009, 14:36
Moin, m2r,

in einer Schleife per FIND die Fundstellen in der Zeile lokalisieren und bei Treffer in ein Array schreiben (rngFound.Column)?

m2r
23.03.2009, 10:55
Hallo Jinx,

habe eine andere Lösung gefunden, um die entsprechenden Spalten ausfindig zu machen. Leider habe ich ein Problem beim kopieren der entsprechenden Daten in das "Master"-Sheet. Die Quelldaten werden richtig ausgewählt, jedoch werden die Daten nicht in den Master kopiert. Kann mir da vielleicht einer von Euch weiterhelfen. Anbei die entsprechende Datei bzw. der Quellcode.


Private Sub cmd_spalten_kopieren_Click()

'Variable benennen
Dim spalte, lspalte As Long
Dim zeile, lzeile As Long
Dim strSearch As String ' Ueberschrift
Dim rngFound As Range

Sheets("Import").Activate

'Ermittlung der letzten Spalte
lspalte = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
lzeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

MsgBox ("Letzte gefunde Spalte " & lspalte)
MsgBox ("Letzte gefunde Zeile " & lzeile)

'Ermittlung der gleichen Spalte
For i = 1 To lspalte 'Spalten werden Durchlaufen in Sheets Import
For j = 1 To 10 'Spalten werden Durchlaufen

If Cells(1, i).Value = Sheets("Master").Cells(1, j) Then

MsgBox ("Übereinstimmung in gefunden in Spalte " & j)

Sheets("Import").Activate
Range(Cells(9, j), Cells(lzeile, j)).Select
Selection.Copy
Sheets("Master").Select
Range(Cells(9, j)).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

Else

End If

Next
Next

End Sub



Bin für jeden Hinweis dankbar.

Gruß m2r

m2r
23.03.2009, 12:31
Hi,

habe in der Zwischenzeit selbst eine Lösung gefunden, die ich Euch nicht vorenthalten möchte. Anbei der entsprechende Code.


Private Sub cmd_spalten_kopieren_Click()

'Variable benennen
Dim spalte, lspalte As Long
Dim zeile, lzeile As Long
Dim strSearch As String ' Ueberschrift
Dim rngFound As Range
Dim quelle As Range
Dim ziel As Range
Dim i, j, x As Long

Sheets("Import").Activate

'Ermittlung der letzten Spalte
lspalte = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
lzeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

'MsgBox ("Letzte gefunde Spalte " & lspalte)
'MsgBox ("Letzte gefunde Zeile " & lzeile)

'Ermittlung der gleichen Spalte
For i = 1 To lspalte 'Spalten werden Durchlaufen in Sheets Import
For j = 1 To 220 'Spalten werden Durchlaufen
For x = 9 To lzeile

If Cells(1, i).Value = Sheets("Master").Cells(1, j) Then

'MsgBox ("Übereinstimmung in gefunden in Spalte " & j)

Sheets("Import").Activate
Range(Cells(9, j), Cells(lzeile, j)).Select
Set quelle = Sheets("Import").Range(Cells(x, i), Cells(x, i))
Set ziel = Sheets("Master").Cells(x, j)
'MsgBox ("Der Zielbereich sollte sein " & j & lzeile)
ziel.Value = quelle.Value


'Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Else

End If

Next
Next
Next

End Sub


Falls jemand noch andere Vorschläge hat, nur her damit.

Gruß m2r