Note: The other languages of the website are Google-translated. Back to English

フォルダからXNUMXつのワークシートに複数のテキストファイルをインポートするにはどうすればよいですか?

たとえば、ここには複数のテキストファイルを含むフォルダーがあります。次のスクリーンショットに示すように、これらのテキストファイルをXNUMXつのワークシートにインポートします。 テキストファイルをXNUMXつずつコピーする代わりに、テキストファイルをXNUMXつのフォルダからXNUMXつのシートにすばやくインポートするためのトリックはありますか?

VBAを使用してXNUMXつのフォルダからXNUMXつのシートに複数のテキストファイルをインポートする

Kutools forExcelを使用してテキストファイルをアクティブセルにインポートします 良いアイデア3


これは、XNUMXつの特定のフォルダーから新しいシートにすべてのテキストファイルをインポートするのに役立つVBAコードです。

1.テキストファイルをインポートするワークブックを有効にして、を押します Altキー+ F11 有効にするキー アプリケーション向け Microsoft Visual Basic 窓。

2。 クリック インセット > モジュール、以下のVBAコードをコピーして モジュール 窓。

VBA:XNUMXつのフォルダからXNUMXつのシートに複数のテキストファイルをインポートする

Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

3。 押す F5 ダイアログを表示し、インポートするテキストファイルを含むフォルダを選択します。 スクリーンショットを参照してください:
docはフォルダからテキストファイルをインポートします1

4。 クリック OK。 次に、テキストファイルが新しいシートとして個別にアクティブなワークブックにインポートされました。
docはフォルダからテキストファイルをインポートします2


XNUMXつのテキストファイルを特定のセルまたは範囲にインポートする場合は、 Kutools for Excelさん カーソル位置にファイルを挿入 ユーティリティ。

Kutools for Excel, 以上で 300 便利な機能は、あなたの仕事をより簡単にします。 

後の 無料インストール Kutools for Excel、以下のようにしてください:

1.テキストファイルをインポートするセルを選択し、をクリックします クツールズプラス > インポート・エクスポート > カーソル位置にファイルを挿入。 スクリーンショットを参照してください:
docはフォルダからテキストファイルをインポートします3

2.次にダイアログが表示され、クリックします ブラウズ を表示する ファイルを選択 セルカーソル位置ダイアログに挿入するには、次に選択します テキストファイル ドロップダウンリストから、インポートするテキストファイルを選択します。 スクリーンショットを参照してください:
docはフォルダからテキストファイルをインポートします4

3。 クリック 開いた > Ok、および指定したテキストファイルがカーソル位置に挿入されています。スクリーンショットを参照してください。
docはフォルダからテキストファイルをインポートします5


最高のオフィス生産性ツール

Kutools for Excelはほとんどの問題を解決し、生産性を80%向上させます

  • 再利用: すばやく挿入 複雑な数式、チャート および以前に使用したものすべて。 セルを暗号化する パスワード付き。 メーリングリストを作成する そしてメールを送る...
  • スーパーフォーミュラバー (複数行のテキストと数式を簡単に編集できます); 読書レイアウト (多数のセルを簡単に読み取って編集する); フィルター範囲に貼り付け...
  • セル/行/列をマージする データを失うことなく; 分割セルコンテンツ; 重複する行/列を組み合わせる...重複セルを防止します。 範囲を比較する...
  • [複製]または[一意]を選択します 行; 空白行を選択 (すべてのセルは空です); スーパーファインドとファジーファインド 多くのワークブックで; ランダム選択...
  • 正確なコピー 数式参照を変更せずに複数のセル。 参照の自動作成 複数のシートに; 箇条書きを挿入、チェックボックスなど...
  • テキストを抽出、テキストの追加、位置による削除、 スペースを削除する; ページング小計の作成と印刷。 セルの内容とコメントを変換する...
  • スーパーフィルター (フィルタースキームを保存して他のシートに適用します); 高度な並べ替え 月/週/日、頻度など。 特殊フィルター 太字、斜体...
  • ワークブックとワークシートを組み合わせる; キー列に基づいてテーブルをマージします。 データを複数のシートに分割; xls、xlsx、PDFをバッチ変換...
  • 300 以上の強力な機能. Office / Excel 2007-2021 および 365 をサポートします。すべての言語をサポートします。 企業や組織に簡単に導入できます。 フル機能の 30 日間無料トライアル。 60日間の返金保証。
kteタブ201905

Officeタブは、タブ付きのインターフェイスをOfficeにもたらし、作​​業をはるかに簡単にします

  • Word、Excel、PowerPointでタブ付きの編集と読み取りを有効にする、パブリッシャー、アクセス、Visioおよびプロジェクト。
  • 新しいウィンドウではなく、同じウィンドウの新しいタブで複数のドキュメントを開いて作成します。
  • 生産性を 50% 向上させ、毎日何百回もマウス クリックを減らすことができます!
officetab下部
コメントを並べ替える
コメント (46)
4の5を評価 · 1の評価
このコメントは、サイトのモデレーターによって最小化されました
Sub Test()
'UpdatebyExtendoffice6 / 7 / 2016
ワークブックとしてxWbを暗くする
xToBookをワークブックとして薄暗くする
文字列としての薄暗いxStrPath
xFileDialog を FileDialog として薄暗くする
文字列としての薄暗いxFile
新しいコレクションとしての薄暗いxFiles
薄暗い私は長く
xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)を設定します
xFileDialog.AllowMultiSelect = False
xFileDialog.Title="フォルダを選択[KutoolsforExcel]"
xFileDialog.Show=-1の場合
xStrPath = xFileDialog.SelectedItems(1)
終了する場合
xStrPath = ""の場合、Subを終了します
If Right(xStrPath、1)<> "\" Then xStrPath = xStrPath& "\"
xFile = Dir(xStrPath& "* .txt")
xFile=""の場合
MsgBox「ファイルが見つかりません」、vbInformation、「KutoolsforExcel」
サブを終了
終了する場合
xFile <> ""
xFiles.Add xFile、xFile
xFile = Dir()
ループ
xToBook=ThisWorkbookを設定します
xFiles.Count>0の場合Then
I=1の場合xFiles.Countへ
xWb = Workbooks.Open(xStrPath&xFiles.Item(I))を設定します
xWb.Worksheets(1).Copy after:= xToBook.Sheets(xToBook.Sheets.Count)
エラーで次の再開
ActiveSheet.Name = xWb.Name
エラー時GoTo0
xWb.Close False
次へ
終了する場合
End Subの

このコードは役に立ちますが、私は欲しいです

タブ、セミコロン、スペースtrueこれを行う方法私を助けてください
このコメントは、サイトのモデレーターによって最小化されました
テキストファイルをシートに変換した後、スペース(区切り文字)を保持しますか?
このコメントは、サイトのモデレーターによって最小化されました
それも私の問題です、このコードは本当です。 ただし、テキストファイルをExcelに変換した後は、区切り文字は保持されません。
このコメントは、サイトのモデレーターによって最小化されました
テキストファイルとあなたが私に望む結果をアップロードしていただけませんか?
このコメントは、サイトのモデレーターによって最小化されました
私も同じ問題を抱えてる。 txtファイルはすべて別々のシートにあり、コードはXNUMXつの列の間のスペースを無視します
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、DesとPB Rama Murty、以下のコードは、テキストファイルをシートにインポートするときに、スペースまたはタブに基づいてデータを列に分割できます。 試してみることができます。

Sub ImportTextToExcel()
'UpdatebyExtendoffice20180911
ワークブックとしてxWbを暗くする
xToBookをワークブックとして薄暗くする
文字列としての薄暗いxStrPath
xFileDialog を FileDialog として薄暗くする
文字列としての薄暗いxFile
新しいコレクションとしての薄暗いxFiles
薄暗い私は長く
薄暗いxIntRowAsLong
薄暗いxFNum、xFArr As Long
Dim xStrValue を文字列として
範囲としての薄暗いxRg
薄暗いxArr
xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)を設定します
xFileDialog.AllowMultiSelect = False
xFileDialog.Title="フォルダを選択[KutoolsforExcel]"
xFileDialog.Show=-1の場合
xStrPath = xFileDialog.SelectedItems(1)
終了する場合
xStrPath = ""の場合、Subを終了します
If Right(xStrPath、1)<> "\" Then xStrPath = xStrPath& "\"
xFile = Dir(xStrPath& "* .txt")
xFile=""の場合
MsgBox「ファイルが見つかりません」、vbInformation、「KutoolsforExcel」
サブを終了
終了する場合
xFile <> ""
xFiles.Add xFile、xFile
xFile = Dir()
ループ
xToBook=ThisWorkbookを設定します
エラーで次の再開
Application.ScreenUpdating = False
xFiles.Count>0の場合Then

I=1の場合xFiles.Countへ
xWb = Workbooks.Open(xStrPath&xFiles.Item(I))を設定します
xWb.Worksheets(1).Copy after:= xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Close False
xIntRow = ActiveCell.CurrentRegion.Rows.Count
xFNum=1の場合xIntRow
xRg = ActiveSheet.Range( "A"&xFNum)を設定します
xArr = Split(xRg.Text、 "")
UBound(xArr)>0の場合
xFArr = 0の場合UBound(xArr)へ
If xArr(xFArr)<> "" Then
xRg.Value = xArr(xFArr)
xRg = xRg.Offset(ColumnOffset:= 1)を設定します
終了する場合
次へ
終了する場合
次へ
次へ
終了する場合
Application.ScreenUpdating = True
End Subの
このコメントは、サイトのモデレーターによって最小化されました
カンマに基づいてデータを列に分割する場合に必要な変更
このコメントは、サイトのモデレーターによって最小化されました
カンマに基づいてデータを列に変換する必要がある場合、どのような変更を行う必要がありますか?
このコメントは、サイトのモデレーターによって最小化されました
私はこれを使用して動作しますが、各シートは毎日のログファイルと同じ情報であるため、すべてを XNUMX つのシートに保存したいと思います。
だから私は組み合わせる必要があります
フォルダ内のすべてのアイテムを XNUMX つのシートに
サブImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
ワークブックとしてxWbを暗くする
xToBookをワークブックとして薄暗くする
文字列としての薄暗いxStrPath
xFileDialog を FileDialog として薄暗くする
文字列としての薄暗いxFile
新しいコレクションとしての薄暗いxFiles
薄暗い私は長く
薄暗いxIntRowAsLong
薄暗いxFNum、xFArr As Long
Dim xStrValue を文字列として
範囲としての薄暗いxRg
薄暗いxArr
エラー時GoToErrHandler
xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)を設定します
xFileDialog.AllowMultiSelect = False
xFileDialog.Title="フォルダを選択[KutoolsforExcel]"
xFileDialog.Show=-1の場合
xStrPath = xFileDialog.SelectedItems(1)
終了する場合
xStrPath = ""の場合、Subを終了します
If Right(xStrPath、1)<> "\" Then xStrPath = xStrPath& "\"
xSht = ThisWorkbook.ActiveSheet を設定します
If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
Application.ScreenUpdating = False
xFile = Dir(xStrPath & "\" & "*.log")
xFile <> ""
Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Close False
xFile = Dir
ループ
Application.ScreenUpdating = True
サブを終了
ErrHandler:
MsgBox「txtファイルなし」、「Kutools for Excel」
End Subの

そして、これはスペースを使用して各列に dd します

Sub ImportTextToExcel()
'UpdatebyExtendoffice20180911
ワークブックとしてxWbを暗くする
xToBookをワークブックとして薄暗くする
文字列としての薄暗いxStrPath
xFileDialog を FileDialog として薄暗くする
文字列としての薄暗いxFile
新しいコレクションとしての薄暗いxFiles
薄暗い私は長く
薄暗いxIntRowAsLong
薄暗いxFNum、xFArr As Long
Dim xStrValue を文字列として
範囲としての薄暗いxRg
薄暗いxArr
xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)を設定します
xFileDialog.AllowMultiSelect = False
xFileDialog.Title="フォルダを選択[KutoolsforExcel]"
xFileDialog.Show=-1の場合
xStrPath = xFileDialog.SelectedItems(1)
終了する場合
xStrPath = ""の場合、Subを終了します
If Right(xStrPath、1)<> "\" Then xStrPath = xStrPath& "\"
xFile = Dir(xStrPath& "* .txt")
xFile=""の場合
MsgBox「ファイルが見つかりません」、vbInformation、「KutoolsforExcel」
サブを終了
終了する場合
xFile <> ""
xFiles.Add xFile、xFile
xFile = Dir()
ループ
xToBook=ThisWorkbookを設定します
エラーで次の再開
Application.ScreenUpdating = False
xFiles.Count>0の場合Then

I=1の場合xFiles.Countへ
xWb = Workbooks.Open(xStrPath&xFiles.Item(I))を設定します
xWb.Worksheets(1).Copy after:= xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Close False
xIntRow = ActiveCell.CurrentRegion.Rows.Count
xFNum=1の場合xIntRow
xRg = ActiveSheet.Range( "A"&xFNum)を設定します
xArr = Split(xRg.Text、 "")
UBound(xArr)>0の場合
xFArr = 0の場合UBound(xArr)へ
If xArr(xFArr)<> "" Then
xRg.Value = xArr(xFArr)
xRg = xRg.Offset(ColumnOffset:= 1)を設定します
終了する場合
次へ
終了する場合
次へ
次へ
終了する場合
Application.ScreenUpdating = True
End Subの
このコメントは、サイトのモデレーターによって最小化されました
Txtファイルにコンマを使用して区切られた区切り文字が含まれている場合はどうすればよいですか?
このコメントは、サイトのモデレーターによって最小化されました
Find and Replace fuctuonを使用して、最初にコンマをスペースに置き換え、上記のいずれかの方法を適用してExcelファイルに変換できます。
このコメントは、サイトのモデレーターによって最小化されました
コードでこれを変更する方法はありませんか? 130個のファイルでこれを行う必要があります
このコメントは、サイトのモデレーターによって最小化されました
同じ質問
このコメントは、サイトのモデレーターによって最小化されました
これについてまだヘルプが必要な場合は、xArr = Split(xRg.Text, " ") を xArr = Split(xRg.Text, ",") に置き換えてください。
このコメントは、サイトのモデレーターによって最小化されました
与えられたとおりにモジュールを実行すると、各.txtファイルが既存のシートへの新しい行としてではなく、新しいシートとして追加されます。 各.txtファイルの新しいシートの代わりに出力としてそれを達成する方法はありますか?
このコメントは、サイトのモデレーターによって最小化されました
すべてのテキストファイルをXNUMXつのシートに結合するという意味ですか?
このコメントは、サイトのモデレーターによって最小化されました
はい、これも私が欲しいものです。
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、Davinder、以下の vba コードを試すことができます。
Sub ImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
    Dim xSht  As Worksheet
    Dim xWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Set xSht = ThisWorkbook.ActiveSheet
    If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
    Application.ScreenUpdating = False
    xFile = Dir(xStrPath & "\" & "*.txt")
    Do While xFile <> ""
        Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
        ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
        xWb.Close False
        xFile = Dir
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "no txt files", , "Kutools for Excel"
End Sub
このコメントは、サイトのモデレーターによって最小化されました
コードは非常に役立ちます。これは、txtファイルをまとめて取得する唯一のコードであり、必要な修正は、JoyceとDavinderが求めているものでもあります。
.txtファイルを抽出し、それらすべてを特定の列(たとえば、列'N')に互いに下に貼り付けることです。

また、インポートされた.txtファイルの「if条件」を次のように追加できるかどうかを知る必要があります。
.txtファイルが文字「A」で始まる場合は、セル「N1」で始まる「シート2」に貼り付けます。
.txtファイルが文字「B」で始まる場合は、セル「N2」で始まる「シート2」に貼り付けます。
それ以外の場合、MsgBoxは「認識されない.txtファイルの目的」になります。

事前にあなたに感謝
このコメントは、サイトのモデレーターによって最小化されました
このコードは機能していますが、それでも一部を変更する必要があります。

※新しいシートを開かずに同じシートに貼り付けて、時間がかかるのでコピーしてほしい。

*インポートされたtxtファイルが文字Aで始まる場合はシート1に貼り付けられ、文字Bで始まる場合はシート2にインポートされる場合は条件付きifを挿入する必要があります


サブtestcopy3()
ワークブックとしてxWbを暗くする
xToBookをワークブックとして薄暗くする
文字列としての薄暗いxStrPath
xFileDialog を FileDialog として薄暗くする
文字列としての薄暗いxFile
新しいコレクションとしての薄暗いxFiles
ディム・アイ・アス・ロング
LastRowを暗くする
範囲として暗くする
xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)を設定します
xFileDialog.AllowMultiSelect = False
xFileDialog.Title="フォルダを選択[KutoolsforExcel]"
xFileDialog.Show=-1の場合
xStrPath = xFileDialog.SelectedItems(1)
終了する場合
xStrPath = ""の場合、Subを終了します
If Right(xStrPath、1)<> "\" Then xStrPath = xStrPath& "\"
xFile = Dir(xStrPath& "* .txt")
xFile=""の場合
MsgBox「ファイルが見つかりません」、vbInformation、「KutoolsforExcel」
サブを終了
終了する場合
xFile <> ""
xFiles.Add xFile、xFile
xFile = Dir()
ループ
Range( "N2")。Select
xToBook=ThisWorkbookを設定します
xFiles.Count>0の場合Then
i=1の場合xFiles.Countへ
xWb = Workbooks.Open(xStrPath&xFiles.Item(i))を設定します
xWb.Activate
'txtデータの選択とコピー
Range(Selection、Selection.End(xlDown))。Select
選択。コピー
xToBook.Activate
ActiveSheet.貼り付け
Selection.End(xlDown).Offset(1).Select
エラーで次の再開
エラー時GoTo0
xWb.Close False
次へ
終了する場合
End Subの
このコメントは、サイトのモデレーターによって最小化されました
すみません、私の手は結ばれています
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、私のコードは実行されますが、最初のファイルのみをインポートします。 コピーのメソッドエラーが発生したと表示されます。 デバッガーは次のコード行を強調表示します。 何か案は?


xWb.Worksheets(1).Copy after:= xToBook.Sheets(xToBook.Sheets.Count)
このコメントは、サイトのモデレーターによって最小化されました
私は同じ問題を抱えています、何か解決策が見つかりましたか?
このコメントは、サイトのモデレーターによって最小化されました
ねえケイティ、
あなたのコメントはかなり古いことは知っていますが、同じ問題に直面し、次のように修正しました。モジュールは、アクティブな.xlsxプロジェクトのサブフォルダーに挿入する必要があります。 コードをPERSONAL.XLSBのサブフォルダーにコピーするのを間違えました。ここでは、通常、マクロを格納し、他のマクロでは実行しますが、このマクロでは実行しません。
このコメントは、サイトのモデレーターによって最小化されました
モジュールの再実行時に重複したくない場合、vbaコードのシートをどのように削除しますか?
このコメントは、サイトのモデレーターによって最小化されました
申し訳ありませんが、繰り返しインポートしないように注意してください。
このコメントは、サイトのモデレーターによって最小化されました
こんにちは私はExcelで先行ゼロを削除しないようにしたいです。

以下のコードを試しましたが、機能しません


Sub Test()
ワークブックとしてxWbを暗くする
xToBookをワークブックとして薄暗くする
文字列としての薄暗いxStrPath
xFileDialog を FileDialog として薄暗くする
文字列としての薄暗いxFile
新しいコレクションとしての薄暗いxFiles
薄暗い私は長く
Dim j As Long
xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)を設定します
xFileDialog.AllowMultiSelect = False
xFileDialog.Title="フォルダを選択"
xFileDialog.Show=-1の場合
xStrPath = xFileDialog.SelectedItems(1)
終了する場合
xStrPath = ""の場合、Subを終了します
If Right(xStrPath、1)<> "\" Then xStrPath = xStrPath& "\"
xFile = Dir(xStrPath& "* .txt")
xFile=""の場合
MsgBox「ファイルが見つかりません」、vbInformation、「KutoolsforExcel」
サブを終了
終了する場合
xFile <> ""
xFiles.Add xFile、xFile
xFile = Dir()
ループ
xToBook=ThisWorkbookを設定します
xFiles.Count>0の場合Then
I=1の場合xFiles.Countへ
xWb = Workbooks.Open(xStrPath&xFiles.Item(I))を設定します
ActiveSheet.Cells.NumberFormat = "@"'これは、テキストファイルデータを貼り付ける前に、テキスト形式でExcelを作成するためのものです。
xWb.Worksheets(1).Copy After:= xToBook.Sheets(xToBook.Sheets.Count)
エラーで次の再開
ActiveSheet.Name = xWb.Name
エラー時GoTo0
xWb.Close False
次へ
終了する場合
End Subの
このコメントは、サイトのモデレーターによって最小化されました
Pooja、Kutools for Excelの先行ゼロの削除機能を試して、インポート後にすべての先行ゼロを選択から削除することができます。
このコメントは、サイトのモデレーターによって最小化されました
しかし、私は削除したくありません。 先行ゼロを削除しないようにしたい。
このコメントは、サイトのモデレーターによって最小化されました
先行ゼロを保持したい場合は、セル形式でテキスト形式としてフォーマットできます。
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、このコードを変更して* .txtファイルを1,2,3,4,5,6,7,8,9,10,11、1,10,11,12,13,14,15,16,17,18,19,2,20,21、XNUMX、XNUMX、XNUMX、XNUMX、XNUMX、XNUMX、XNUMX、XNUMX、XNUMXなどの順序で挿入するにはどうすればよいですか。現在、コードは次のようにファイルを挿入します:XNUMX、 XNUMXなど。ありがとう!
このコメントは、サイトのモデレーターによって最小化されました
txtファイル名から特定の部分だけのシート名を取得する可能性はありますか?

上記のコードに従って、シート名全体が使用されています。
このコメントは、サイトのモデレーターによって最小化されました
たくさんのおかげでオフィス2007の仕事は優れています
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、私のコードは実行されますが、最初のファイルのみをインポートします。 コピーのメソッドエラーが発生したと表示されます。 デバッガーは次のコード行を強調表示します。 何か案は?


xWb.Worksheets(1).Copy after:= xToBook.Sheets(xToBook.Sheets.Count)
このコメントは、サイトのモデレーターによって最小化されました
ねえマルティニョ、
私は同じ問題を抱えていて、この行を変更することでそれを解決しました:
xToBook=ThisWorkbookを設定します
〜へ
xToBook=ActiveWorkbookを設定します
多分これは役に立ちます。
このコメントは、サイトのモデレーターによって最小化されました
0

私はあなたが助けを必要としています私は何も考えていませんvbaexcel私は13000のような複数のテキストファイルをインポートしたいです。たとえばセルと同じテキストファイル名(c1 = 112なのでテキストファイル名も112)はテキストファイル112がc112をインポートします。
このコメントは、サイトのモデレーターによって最小化されました
私はあなたが助けを必要としています私は何も考えていませんvbaexcel私は13000のような複数のテキストファイルをインポートしたいです。たとえばセルと同じテキストファイル名(c1 = 112なのでテキストファイル名も112)はテキストファイル112がc112をインポートします。
このコメントは、サイトのモデレーターによって最小化されました
コードは機能しますが、各テキストファイルをブックの新しいタブにインポートします。 コードのどこでこれを変更して、最後のテキストファイルのデータの下にある同じワークシートに新しいテキストファイルをインポートできるか考えてみてください。
このコメントは、サイトのモデレーターによって最小化されました
以下のコードでは、テキスト ファイルをインポートするたびにパスを選択するのではなく、フォルダーを指定する場合、どのような変更を行う必要がありますか

VBA コード:

サブImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
Dim xSht As ワークシート
ワークブックとしてxWbを暗くする
文字列としての薄暗いxStrPath
xFileDialog を FileDialog として薄暗くする
文字列としての薄暗いxFile
エラー時GoToErrHandler
xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)を設定します
xFileDialog.AllowMultiSelect = False
xFileDialog.Title="フォルダを選択[KutoolsforExcel]"
xFileDialog.Show=-1の場合
xStrPath = xFileDialog.SelectedItems(1)
終了する場合
xStrPath = ""の場合、Subを終了します
xSht = ThisWorkbook.ActiveSheet を設定します
If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
Application.ScreenUpdating = False
xFile = Dir(xStrPath & "\" & "*.txt")
xFile <> ""
Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Close False
xFile = Dir
ループ
Application.ScreenUpdating = True
サブを終了
ErrHandler:
MsgBox「txtファイルなし」、「Kutools for Excel」
End Subの
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、以下のコードを試してください
Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    xStrPath = "C:\Users\AddinsVM001\Desktop\test" 'Here is the parth you can modify
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

「C:\Users\AddinsVM001\Desktop\test」は、テキスト ファイルのインポート元のフォルダー パスです。必要に応じて変更してください。
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、貴重な VBA コードをありがとうございます。
ただし、複数のtxtファイルを「txtファイルごとに個別のシートではなく、ワークシート内の単一のシート」にするためのコードが必要です。
私の目的のためにあなたのコードを編集する必要がありますか?

おかげで、
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、以下のコードを試してください
Sub Test()
    'UpdatebyExtendoffice 10/26/2022
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Dim J As Long
    Dim xRg As Range
    Dim xSaveRg As Range
    Dim xSh As Worksheet
    
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    Set xSh = xToBook.Sheets.Add
    Set xRg = xSh.Range("A1")
    J = 1
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            Set xSaveRg = xWb.Worksheets(1).UsedRange
            J = xSaveRg.Rows.Count + 1 + J
            Debug.Print xRg.Address
            xSaveRg.Copy Destination:=xRg
            On Error Resume Next
            xWb.Close False
            
            Set xRg = xSh.Cells(J, 1)
        Next
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
このコメントは、サイトのモデレーターによって最小化されました
これはうまくいきます。 しかし、インポートすると、シートの名前が name.txt に変更され、シートに .txt 拡張子を追加せずに名前のみを保持する方法は?
3.5の5を評価
このコメントは、サイトのモデレーターによって最小化されました
OK nvm は Google ヘルプで答えを見つけました。
行を置き換える:
ActiveSheet.Name = xWb.Name
と:
ActiveSheet.Name = Left(xWb.Name,Len(xWb.Name)-4)
シート名から最後の 4 文字を削除します。 必要なものを効果的に与えてくれます。 .txt なしの名前
乾杯
4の5を評価
このコメントは、サイトのモデレーターによって最小化されました
以下のコードは、テキスト ファイルをシートにインポートする際に、スペースまたはタブに基づいてデータを列に分割できます。 しかし、各txtファイルに個別のタブは必要ありません。すべてをXNUMXつのシートにまとめたいと思います。 情報は、各ファイルで同じ形式です。 . インポートされた各ファイルが新しいタブになるのではなく、これをすべてXNUMXつのシートにするために変更できるもの

Sub ImportTextToExcel()
'UpdatebyExtendoffice20180911
ワークブックとしてxWbを暗くする
xToBookをワークブックとして薄暗くする
文字列としての薄暗いxStrPath
xFileDialog を FileDialog として薄暗くする
文字列としての薄暗いxFile
新しいコレクションとしての薄暗いxFiles
薄暗い私は長く
薄暗いxIntRowAsLong
薄暗いxFNum、xFArr As Long
Dim xStrValue を文字列として
範囲としての薄暗いxRg
薄暗いxArr
xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)を設定します
xFileDialog.AllowMultiSelect = False
xFileDialog.Title="フォルダを選択[KutoolsforExcel]"
xFileDialog.Show=-1の場合
xStrPath = xFileDialog.SelectedItems(1)
終了する場合
xStrPath = ""の場合、Subを終了します
If Right(xStrPath、1)<> "\" Then xStrPath = xStrPath& "\"
xFile = Dir(xStrPath& "* .txt")
xFile=""の場合
MsgBox「ファイルが見つかりません」、vbInformation、「KutoolsforExcel」
サブを終了
終了する場合
xFile <> ""
xFiles.Add xFile、xFile
xFile = Dir()
ループ
xToBook=ThisWorkbookを設定します
エラーで次の再開
Application.ScreenUpdating = False
xFiles.Count>0の場合Then

I=1の場合xFiles.Countへ
xWb = Workbooks.Open(xStrPath&xFiles.Item(I))を設定します
xWb.Worksheets(1).Copy after:= xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Close False
xIntRow = ActiveCell.CurrentRegion.Rows.Count
xFNum=1の場合xIntRow
xRg = ActiveSheet.Range( "A"&xFNum)を設定します
xArr = Split(xRg.Text、 "")
UBound(xArr)>0の場合
xFArr = 0の場合UBound(xArr)へ
If xArr(xFArr)<> "" Then
xRg.Value = xArr(xFArr)
xRg = xRg.Offset(ColumnOffset:= 1)を設定します
終了する場合
次へ
終了する場合
次へ
次へ
終了する場合
Application.ScreenUpdating = True
End Subの
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、ダニエル、以下のコードを試してください。すべてのテキスト ファイルを Txt という名前の XNUMX つのシートにインポートします。
注意: テキスト名が既存のシート名と同じ場合、テキスト ファイルがインポートされない場合があります。
Sub ImportTextToExcel2()

'UpdatebyExtendoffice20230106

Dim xWb As Workbook

Dim xToBook As Workbook

Dim xStrPath As String

Dim xFileDialog As FileDialog

Dim xFile As String

Dim xFiles As New Collection

Dim I As Long

Dim xIntRow As Long

Dim xFNum, xFArr As Long

Dim xStrValue As String

Dim xRg As Range

Dim xArr

Dim xRowL, xRowH As Integer

Dim xTxtWS, xWSD As Worksheet

Dim xTxtWS_Rg As Range

Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)

xFileDialog.AllowMultiSelect = False

xFileDialog.Title = "Select a folder [Kutools for Excel]"

If xFileDialog.Show = -1 Then

xStrPath = xFileDialog.SelectedItems(1)

End If

If xStrPath = "" Then Exit Sub

If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"

xFile = Dir(xStrPath & "*.txt")

If xFile = "" Then

MsgBox "No files found", vbInformation, "Kutools for Excel"

Exit Sub

End If

Do While xFile <> ""

xFiles.Add xFile, xFile

xFile = Dir()

Loop

Set xToBook = ThisWorkbook

On Error Resume Next

Set xTxtWS = xToBook.Worksheets("Txt")

If IsNull(xTxtWS) Or IsEmpty(xTxtWS) Then

    Set xTxtWS = xToBook.Worksheets.Add

    xTxtWS.Name = "Txt"

End If

Application.ScreenUpdating = False

Application.DisplayAlerts = False

xTxtWS.Activate

If xFiles.Count > 0 Then

xRowL = 1

For I = 1 To xFiles.Count

Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))

xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)

Set xWSD = xToBook.Sheets(xToBook.Sheets.Count)

xTxtWS.Activate

xWb.Close False

xIntRow = xWSD.UsedRange.CurrentRegion.Rows.Count

    For xFNum = 1 To xIntRow

        Set xRg = xWSD.Range("A" & xFNum)

        xArr = Split(xRg.Text, " ")

        Set xTxtWS_Rg = xTxtWS.Cells.Range("A" & xRowL)

'        If UBound(xArr) > 0 Then

            For xFArr = 0 To UBound(xArr)

                If xArr(xFArr) <> "" Then

                xTxtWS_Rg.Value = xArr(xFArr)

                Set xTxtWS_Rg = xTxtWS_Rg.Offset(ColumnOffset:=1)

                End If

            Next

'        End If

xRowL = xRowL + 1

    Next

xWSD.Delete

Next

End If

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub


ここにはまだコメントが投稿されていません
あなたのコメントを残す
ゲストとして投稿
×
この投稿を評価:
0   文字
推奨される場所

フォローする

著作権©の2009 - WWW。extendoffice.com。 | | 全著作権所有。 搭載 ExtendOffice。 | サイトマップ
MicrosoftおよびOfficeのロゴは、米国MicrosoftCorporationの米国およびその他の国における商標または登録商標です。
SectigoSSLで保護