Office: Excel07 Mehrere Spektren in eine excel Tabelle einfügen!!!

Hallo!! Habe folgendes problem!! Hab ca 600 spektren aufgenommen ascii format und möchte gerne diese in eine excel tabelle aufmachen. Es dauert sehr lange die einzel aufzumachen und einzeln rein zu kopieren!! :-((

 

Re: Excel07 Mehrere Spektren in eine excel Tabelle einfügen!

Es ist sicherlich kein unlösbares Problem, eine Massen-Abarbeitung per VBA hinzubekommen. Aber... Was sind diese Spektren?

Gruß, Michael

 

Hi michael!! Es sind Nah-ifrarot-spektren in dieser form:
Wellenläge: Intensität: und davon 600

1085 -0.9652659
1086 -0.8324849
1087 -0.6997039
1088 -0.5669229
1089 -0.4341419
1090 -0.4270729
1091 - 0.4612285
1092 -0.4953841

 

Hallo Joaquín!

Soll dann in Excel so etwas herauskommen?

	A	B
1	Wellenlänge	Intensität
2	1085	-0,9652659
3	1086	-0,8324849
4	1087	-0,6997039
5	1088	-0,5669229
6	1089	-0,4341419
7	1090	-0,4270729
8	1091	-0,4612285
9	1092	-0,4953841

Dann kannst Du einfach die vorliegende Text-Datei mit Excel öffnen (Rechtsklick ... Öffnen mit ...).
Dann die eine Spalte markieren, DATEN > TEXT IN SPALTEN, der Menüführung folgen und als Trennzeichen LEERZEICHEN wählen.
Ersetzung der Punkte durch Kommata über die ERSETZEN-Funktion.

 

HI! Nein das Problem mit dem Komma hab ich nicht!! Mein Problem ist das 600 einzel Spektren habe (600 dateien) und die sollen alle in eine Excel-Tabelle also eine Datei. Die Dateien einzeln zu öffnen und rein zu kopieren dauert ewig!!! Mit den Punkten ist kein problem hab mein Pc auf Englisch eingestellt. Gruß Joaqin

.

 

Ich hab Dir mal aus einem Modul, daß eine Sammlung von Routinen rund um das Thema enthält, eine abgespeckte und angepaßte Version zusammengestellt:

Code:

Option Explicit

Const TmpTargetSheet = "tmp"

Public Function ExtractFileDrive(DPF$) As String

    Dim T As Integer
    Dim R As String

    R = DPF

    T = InStr(R, ":")
    If T > 0 Then
        R = Left$(R, T)
      Else
        T = InStr(R, "$")
        If T > 0 Then
            R = Left$(R, T)
          Else
            R = ""
        End If
    End If

    ExtractFileDrive = R

End Function

Public Function ExtractFilePath(DPF$) As String

    Dim R As String
    Dim d As Integer
    Dim f As Integer

    R = DPF
    d = Len(ExtractFileDrive(R))
    f = Len(ExtractFileName(R))
    R = Mid$(R, d + 1, Len(R) - (d + f))

    ExtractFilePath = R

End Function

Public Function ExtractFileName(DPF$) As String

    Dim T As Integer
    Dim R As String

    R = DPF

    T = InStr(R, "\")
    While T > 0
        R = Right$(R, Len(R) - T)
        T = InStr(R, "\")
    Wend

    ExtractFileName = R

End Function

Public Sub Sht_Erstellen(TargetSheet$)

    ThisWorkbook.Activate

    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Worksheets(TargetSheet).Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    ThisWorkbook.Worksheets.Add
    ThisWorkbook.ActiveSheet.Name = TargetSheet
    ThisWorkbook.Worksheets(TargetSheet).Move after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

    ThisWorkbook.Worksheets(TargetSheet).Activate
    ThisWorkbook.ActiveSheet.Range("a1").Activate
    ThisWorkbook.ActiveSheet.Range("a1").Select

End Sub

Public Sub Sht_Loeschen(TargetSheet$)

    Application.DisplayAlerts = False
    On Error Resume Next
    Worksheets(TargetSheet).Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

End Sub

Public Sub Import_Txt(ImportDrive$, ImportPath$, ImportFile$, TargetSheet$)

    Sht_Erstellen TargetSheet

    With ThisWorkbook.Worksheets(TargetSheet).QueryTables.Add(Connection:="TEXT;" & ImportDrive & ImportPath & ImportFile, Destination:=ThisWorkbook.Worksheets(TargetSheet).Range("a1"))
        .Name = TargetSheet
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = xlWindows
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        'If Not IsNull(tcf) Then
        '    .TextFileColumnDataTypes = tcf
        'End If
        .Refresh BackgroundQuery:=False
    End With

End Sub

Private Function AnzahlZeilen(ByVal s$, ByVal C$) As Long

    Dim MyRange As Range

    Set MyRange = Worksheets(s).Range(C & ":" & C)
    AnzahlZeilen = Application.WorksheetFunction.CountA(MyRange)

End Function

Private Sub Kopiere_Tmp_An_Import(TmpTargetSheet$, TargetSheet$)

    Dim Y1 As Long
    Dim Y2 As Long

    ThisWorkbook.Activate
    Worksheets(TmpTargetSheet).Activate

    Y1 = AnzahlZeilen(TmpTargetSheet, "A")
    Y2 = AnzahlZeilen(TargetSheet, "A") + 1

    Worksheets(TmpTargetSheet).Rows("1:" & Y1).Copy Destination:=Worksheets(TargetSheet).Cells(Y2, 1)

End Sub

Public Sub Import_Alle_Txt(ImportDrive$, ImportPath$, ImportFileMask$, TargetSheet$)

    Dim FS As Object
    Dim I As Integer

    Sht_Erstellen TargetSheet

    Set FS = Application.FileSearch
    With FS
        .NewSearch
        .LookIn = ImportDrive & ImportPath
        .SearchSubFolders = False
        .Filename = ImportFileMask
        .MatchTextExactly = True
        .FileType = msoFileTypeAllFiles
        If .Execute() > 0 Then
            For I = 1 To .FoundFiles.Count
                Import_Txt ExtractFileDrive(.FoundFiles(I)), ExtractFilePath(.FoundFiles(I)), ExtractFileName(.FoundFiles(I)), TmpTargetSheet
                Kopiere_Tmp_An_Import TmpTargetSheet, TargetSheet
            Next I
            Sht_Loeschen TmpTargetSheet
        End If
    End With

End Sub

Importiere diesen Teil mal in ein Modul:
mit Alt-F11 in den VBA-Editor wechseln
über das Menü "Einfügen - Modul" ein neues Modul erzeugen
obigen Code-Block dort einkopieren

Dann zum Ausprobieren:
Setze einen Button (Symbolleiste "Steuerelemente-Toolbox") auf das Arbeitsblatt "Tabelle1"
Klicke mit der rechten Maustaste auf den Button und wähle "Code anzeigen"
Kopiere als 1. Ansatz folgenden Ausschnitt zwischen SUB und END SUB:

Code:

    Dim d As String
    Dim p As String
    Dim f As String
    Dim s As String

    d = "\\juprds03\kec_product_service$"
    p = "\KV_AUSWERT\Datenquellen\tmp\"
    f = "????_??_??_s5102_pdd_sum_kft.txt"
    s = "import"

    Import_Alle_Txt d, p, f, s

Jetzt mußt Du den Kram nur noch an einigen Stellen an Deine "örtlichen Gegebenheiten" anpassen. In erster Linie betrifft das natürlich obige Laufwerks-, Pfad- und dateimasken-Angaben.

Im "Modul1" gibt es aber auch noch die Routine "Import_Txt", die wahrscheinlich angepaßt werden muß. Z.Z. ist sie z.B. auf das ";" als Trennzeichen eingestellt, was bei Dir ja eher das " " (also das Leerzeichen) sein wird.

Aber probier mal erstmal aus und dann kannst du ja berichten, wo es vielleicht noch hakt.

Gruß, Michael

 

Hallo Michael danke für deine Hilfe!!! Hab ein paar Probleme weil ich noch nie mit Visual Basic gearbeitet habe. Konnte auf Tabelle 1 kein Button setzen. Erst wenn ich Userform 1 aufmache ist der werkzeugkasten aktiviert. Hab dann den Button auf Userform gezogen und aufgemacht. Meine Daten sind auf c:\Diplom\Bayermischer\Neu und in Neu sind dann die Spektren,heißen 000090, 000091, 00092......... bis 000689. Die enden auf .dat! Ich weiss nicht wie es hier eingeben soll?

Dim d As String
Dim p As String
Dim f As String
Dim s As String

d = "\\juprds03\kec_product_service$"
p = "\KV_AUSWERT\Datenquellen\tmp\"
f = "????_??_??_s5102_pdd_sum_kft.txt"
s = "import"

Import_Alle_Txt d, p, f, s

Gruß Joaqin

 

Bekomme ich keine Antwort mehr?? :-(

 

(Ähnlich dem Rheinland gibt es auch in Kiel eine Art 5. Jahreszeit. Diese "Kieler Woche" hab ich mir dann mal eine urlaubsmäßige Auszeit genommen... ;-) )

Hmmm... Versteh ich jetzt nicht ganz. Die Symbolleiste "Steuerelemente-Toolbox" ist gemeint, ja? Die ist eigentlich immer aktiv, nicht nur bei User-Forms.

Genau hier.
d --> Laufwerk --> "c:"
p --> Pfad --> "\Diplom\Bayermischer\Neu\"
f --> Datei --> "000???.dat"
Wobei f die Dateimaske ist, wie man sie z.B. auch beim "dir" Befehl benutzt. Wenn die "001000.dat" erreicht wird, müßte f dann angepaßt werden. Alternativ würde ich vorschlagen
f = "*.dat"
zu benutzen, wenn sich keine weiteren Dateien in dem Verzeichnis befinden.

Gruß, Michael