https://qiita.com/nkay/items/9334679cdcea90eebd1e
https://www.sejuku.net/blog/69321?utm_source=blog&utm_medium=blog&utm_campaign=blog__69323
'方法1 QueryTables
2秒
'方法2 csvファイルをシートレベルで置き換え
2秒
'方法3 csvファイルをテキストファイルとして開いてエクセルへ書き込み
59秒
-- 1. 開発タブの挿入でボタンを作成
※ActiveXコントロールのものを使用する
-- 2. デザインモードONで作成したボタンをダブルクリックするとエディタが開くので下記コードを記載。デザインモードOFFで実行
Option Explicit
Dim i As Long
Private Sub CommandButton1_Click()
'画面を更新しない
Application.ScreenUpdating = False
'確認メッセージを表示しない
Application.DisplayAlerts = False
'テストcsvファイル作成
Call createTextFile(ThisWorkbook.Path & "\" & "a.csv")
Dim wb As Workbook
'テストエクセルファイル作成
If Dir(ThisWorkbook.Path & "\" & "a.xlsx") <> "" Then
Kill ThisWorkbook.Path & "\" & "a.xlsx"
End If
Set wb = Workbooks.Add
wb.Worksheets(wb.Worksheets.Count).Name = "data"
wb.SaveAs ThisWorkbook.Path & "\" & "a.xlsx"
wb.Save
wb.Close
Dim t1 As Double
Dim t2 As Double
Dim wb2 As Workbook
t1 = Timer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'方法1 QueryTables
Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & "a.xlsx")
wb.Worksheets("data").Cells.ClearContents
wb.Worksheets("data").Rows.Hidden = False
Dim qt As QueryTable
Set qt = wb.Worksheets("data").QueryTables.Add(Connection:="TEXT;" & ThisWorkbook.Path & "\" & "a.csv", Destination:=wb.Worksheets("data").Range("A1"))
With qt
.TextFileCommaDelimiter = True
.Refresh
.Delete
End With
wb.Save
wb.Close
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'方法2 csvファイルをシートレベルで置き換え
Set wb2 = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & "a.csv", Format:=2)
Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & "a.xlsx")
wb2.Worksheets(1).Copy after:=wb.Worksheets("data")
wb.Worksheets("data").Delete
wb.Worksheets("a").Name = "data"
wb.Save
wb.Close
wb2.Close
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'方法3 csvファイルをテキストファイルとして開いてエクセルへ書き込み
Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & "a.xlsx")
wb.Worksheets("data").Cells.ClearContents
wb.Worksheets("data").Rows.Hidden = False
Dim i As Long
Dim j As Long
Dim buf As String
Dim s As Variant
i = 1
Open ThisWorkbook.Path & "\" & "a.csv" For Input As #1
Do Until EOF(1)
Line Input #1, buf
s = Split(buf, ",")
For j = LBound(s) To UBound(s)
wb.Worksheets("data").Cells(i, j + 1).Value = s(j)
Next j
i = i + 1
Loop
Close #1
wb.Save
wb.Close
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
t2 = Timer
Debug.Print " t2 - t1", t2 - t1
MsgBox "処理完了"
'確認メッセージを表示する
Application.DisplayAlerts = True
'画面を更新する
Application.ScreenUpdating = True
End Sub
'ファイル作成関数
Private Sub createTextFile(filepath As String)
Open filepath For Output As #1
Dim i As Long
For i = 1 To 100000
Print #1, CStr(Int(100 * Rnd)) & "," & CStr(Int(100 * Rnd)) & "," & CStr(Int(100 * Rnd))
Next i
Close #1
End Sub
