-1

選択したディレクトリから多数のtxtファイルを配列またはExcelシートにロードする必要があります。txt ファイルの構造は次のようになります。

*

SST - 0010
Narzędzie - 08A38902
Miernik 0010  Nr seryjny = 90375091 Nr artykułu = 1010953
Moment obrotowy = 2,080 N.m Kąt obrotu = 5380,000 grd
Wartość zadana  = 5,000 N.m DG = 0,000 N.m  GG = 10,000 N.m
Kąt docelowy = 0,000 grd    Moment docelowy = 5,000 N.m
Wartość progowa = 0,200 N.m Wartość dokr. = 5,000 N.m
wartość KPIL = Wył. Czas martwy = 0,00 s    Współcz.nach. = > 1,00  Prędkość 
kątowa = 0,000
Cm =  2.42  Cmk =  1.04 Xpoprz =  2.15  
Czas [s]    Kanał 1 [N.m]   Kanał 2 [grd]
0   0,21    0
0,008   0,23    18
0,016   0,24    40,5
0,024   0,26    59,5
0,032   0,27    87,5
0,04    0,28    112,5
0,048   0,3 137,5
...
...
...

*

行 14 から EndOfFile までの行をロードする必要があります。

データは、表で区切られた 3 つの列にあります。さらに目的のために、データを3つのExcel列にコピーしたいと考えています。

各ファイルは、次の一連の列にロードする必要があります。

問題がなければ、シートに埋め込まれたボタンを使用してマクロを実行することをお勧めします。

私は実際にタスクを実行するためにさまざまな方法を試しましたが、失敗したので、あなたの助けを求めます:)。

最後にこのコードを試しました：

Sub LOAD_REAL_DATA()

Dim Filt As String
Dim FilterIndex As Integer
Dim Title As String
Dim FileName As Variant

Filt = "All Files (*.*),*.*"
Title = "Select a Txt File to Import"
FileName = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title)

If FileName = False Then
MsgBox "No File Was Selected"
Exit Sub
End If

With Application.ActiveSheet
    Cells.Select
Selection.QueryTable.Delete
Selection.ClearContents
End With

Workbooks.Open FileName
End Sub

「400 エラー」メッセージが表示されます...

tris コードを使用すると、ほとんどの作業が行われますが、L42 返信の下のコメントにいくつかの問題がリストされています。

Sub LOAD_TOOL_DATA()
Dim a, b, c As Integer
Dim TARFIL
On Error GoTo nofile
TEMPNAM = ActiveWorkbook.Name
Application.ScreenUpdating = False
TARFIL = Application.GetOpenFilename(filefilter:="All Files (*.*), *.*", MultiSelect:=True)
'Set multiselect to true so you can select all file you want to load
b = UBound(TARFIL, 1) 'get the size of the array of files you just created
c = 1
'Loop through those files
Do
    Sheets("Arkusz1").Select
    a = 1
    'this loop is to ensure you do not copy same files
    Do
    Select Case Cells(a, 1).Value
    Case TARFIL(c)
        GoTo jump
    Case ""
        Cells(a, 1).Value = TARFIL(c)
        x = 1
    Case Else
    a = a + 1
    x = 0
    End Select

    Loop Until x = 1
    'this part opens the filename. In this case the txt file have 12 colums.
    ' if you have fewer columns then delete some Array(x,x) on the FieldInfo: part. You can also get this by recording Macro.
    Workbooks.OpenText FileName:=TARFIL(c), startRow:=14, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False _
    , Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 2), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1))

    OPNFIL = ActiveWorkbook.Name
    'this part specifies that it will only copy data from row 5 as indicated
    Range(Cells(5, 1), Cells(Application.WorksheetFunction.CountA(Columns("A:A")) + 1, 12)).Select
    Selection.Copy
    Windows(TEMPNAM).Activate
    Sheets("Arkusz1").Select
    Cells(Application.WorksheetFunction.CountA(Columns("A:A")) + 1, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows(OPNFIL).Close
jump:
    c = c + 1
Loop Until c > b

Exit Sub
nofile:
'    MsgBox "No File Selected", vbInformation, "Load File Error"
End Sub

OK みんな、このコードはほぼ完璧に動作しますが: ;)

Sub LOAD_TOOL_DATA()
Dim a, b, c As Integer
Dim TARFIL 'Array for the file data
On Error GoTo nofile
TEMPNAM = ActiveWorkbook.Name
Application.ScreenUpdating = False
TARFIL = Application.GetOpenFilename(filefilter:="All Files (*.*), *.*", MultiSelect:=True)
'Set multiselect to true so you can select all file you want to load
b = UBound(TARFIL, 1) 'get the size of the array of files you just created
c = 1
'Loop through those files
Do
    Sheets(8).Select
    a = 1
    'This loop is to ensure you do not copy same files
    Do
    Select Case Cells(a, 1).Value
    Case TARFIL(c)
        GoTo jump
    Case ""
        Cells(a, 1).Value = TARFIL(c)
        x = 1
    Case Else
    a = a + 1
    x = 0
    End Select

    Loop Until x = 1
    'this part opens the filename. In this case the txt file have 3 colums.
    ' if you have fewer/ more columns then delete/ add some Array(x,x) on the FieldInfo: part (where (x,x) is (column, row) index.
    Workbooks.OpenText FileName:=TARFIL(c), startRow:=14, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1))

    OPNFIL = ActiveWorkbook.Name
    'this part specifies that it will only copy data from row 1 to EOF and from column 1 to 3
    Range(Cells(1, 1), Cells(Application.WorksheetFunction.CountA(Columns("A:A")) + 1, 3)).Select
    Selection.Copy
    Windows(TEMPNAM).Activate
    Sheets(8).Select
    Cells(Application.WorksheetFunction.CountA(Columns("A:A")) + 1, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows(OPNFIL).Close
jump:
    c = c + 1
Loop Until c > b
Application.ScreenUpdating = True
Exit Sub
nofile:
'    MsgBox "No File Selected", vbInformation, "Load File Error"
End Sub
  • 複数ファイルの選択が機能しない、
  • 最初の行のターゲット シートで、ファイル パスにファイル名を貼り付けます (必要ありません)。

別のターゲットを選択するように変更する方法 (他のシートとセル アドレスから - B9 から EOF まで)?

4

3 に答える 3

2

カンマ区切りの csv テキスト ファイルを読み込むコードを次に示します。
これを機能させるのに役立つかもしれない私のコメントを参照してください。
これにより、すべてのファイル コンテンツがシート 1 に読み込まれ、トラッカーがシート 2 に配置されて、重複した日付が読み込まれないようにします。

Sub Load_File()

Dim a, b, c As Integer
Dim TARFIL

On Error GoTo nofile

TEMPNAM = ActiveWorkbook.Name
Application.ScreenUpdating = False
TARFIL = Application.GetOpenFilename(filefilter:="Text Files (*.csv), *.csv", MultiSelect:=True) 'Set multiselect to true so you can select all file you want to load

b = UBound(TARFIL, 1) 'get the size of the array of files you just created
c = 1
'Loop through those files
Do
    Sheets(2).Select
    a = 1
    'this loop is to ensure you do not copy same files
    Do

    Select Case Cells(a, 1).Value

    Case TARFIL(c)
        GoTo jump
    Case ""
        Cells(a, 1).Value = TARFIL(c)
        x = 1
    Case Else

    a = a + 1
    x = 0

    End Select

    Loop Until x = 1

    'this part opens the filename. In this case the txt file have 12 colums. if you have fewer columns then delete some Array(x,x) on the FieldInfo: part. You can also get this by recording Macro.
    Workbooks.OpenText Filename:=TARFIL(c), startRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
    , Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 2), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1))

    OPNFIL = ActiveWorkbook.Name
    'this part specifies that it will only copy data from row 5 as indicated
    Range(Cells(5, 1), Cells(Application.WorksheetFunction.CountA(Columns("A:A")) + 1, 12)).Select
    Selection.Copy
    Windows(TEMPNAM).Activate
    Sheets(1).Select
    Cells(Application.WorksheetFunction.CountA(Columns("A:A")) + 1, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows(OPNFIL).Close

jump:
    c = c + 1

Loop Until c > b

Exit Sub
nofile:
    MsgBox "No File Selected", vbInformation, "Load File Error"

End Sub

ここで重要なのは、既に読み込まれているテキスト ファイルを読み込むと、どのように見えるかです。次に、上記のコードを置き換えることができます。

于 2013-10-03T10:04:20.723 に答える
0

最後に、高速かつエレガントに動作するコードを作成しました (ユーザー向け):

Option Base 1

Sub LOAD_REAL_DATA()
'loading text files into excel sheet no 9. Every 3 columns are fixed next each other
Dim i, b, c As Integer
Dim TARFIL

On Error GoTo nofile
Application.ScreenUpdating = False
TEMPNAM = ActiveWorkbook.Name
TARFIL = Application.GetOpenFilename(filefilter:="All Files (*.*), *.*", MultiSelect:=True)
b = UBound(TARFIL, 1)
c = 1
i = 1
For i = 1 To b
    Sheets(9).Select
        Workbooks.OpenText FileName:=TARFIL(i), StartRow:=14, TextQualifier:=xlSingleQuote, ConsecutiveDelimiter:=False, Space:=True
        OPNFIL = ActiveWorkbook.Name
        Range(Cells(1, 1), Cells(Application.WorksheetFunction.CountA(Columns("A:A")) + 1, 3)).Select
    Selection.Copy
    Windows(TEMPNAM).Activate
        Application.Worksheets(9).Select
        Cells(1, c).Select
        ActiveSheet.Paste
        Application.CutCopyMode = xlCopy
    Windows(OPNFIL).Close
    c = c + 3
Next i
Application.ScreenUpdating = True
Exit Sub
nofile:
    MsgBox "No File Selected", vbInformation, "Load File Error"
End Sub

私のベースとなったコードサンプルを提供してくれたL42に感謝します。アレックス P にも感謝します。残念ながら、あなたのコードは遅すぎました。理由はわかりません。

L42 コードに基づいて、これを作成することができました。みんなありがとう！

于 2013-10-08T12:03:56.237 に答える