今回は、ExcelファイルとCSVファイルを読み込む4つの方法を8つのひな形でご紹介します。
コードのひな形ですので、説明は極力省略します。
詳細については下記記事をご覧ください。
1.指定したファイルを開いて読み込む
1シートのみ読み込む
Worksheets(1).Copy afterの(1)の部分を変える事で読み込むシートを変更できます。
また、Worksheets(“ファイル名”)で指定する事も可能です。
Sub Sample1()
Dim Filename As String
Dim ShCount As Long
ShCount = ThisWorkbook.Worksheets.Count
If Dir("C:\Sample\Book1.xlsx") <> "" Then
Filename = Dir("C:\Sample\Book1.xlsx")
Workbooks.Open "C:\Sample\Book1.xlsx"
Worksheets(1).Copy after:=ThisWorkbook.Worksheets(ShCount)
Workbooks(Filename).Close savechanges:=False
End If
End Subすべてのシートを読み込む
「Worksheets.Copy after」とWorksheetsコレクションを指定する事ですべて読み込めます。
Sub Sample2()
Dim Filename As String
Dim ShCount As Long
ShCount = ThisWorkbook.Worksheets.Count
If Dir("C:\Sample\Book1.xlsx") <> "" Then
Filename = Dir("C:\Sample\Book1.xlsx")
Workbooks.Open "C:\Sample\Book1.xlsx"
Worksheets.Copy after:=ThisWorkbook.Worksheets(ShCount)
Workbooks(Filename).Close savechanges:=False
End If
End Sub非表示を表示する方法
読み込んだシートの中に非表示があると、そのまま非表示になるため、念のためすべて再表示します。
Sub Sample3()
Dim Filename As String
Dim ShCount As Long
Dim Sh As Worksheet
ShCount = ThisWorkbook.Worksheets.Count
If Dir("C:\Sample\Book1.xlsx") <> "" Then
Filename = Dir("C:\Sample\Book1.xlsx")
Workbooks.Open "C:\Sample\Book1.xlsx"
Worksheets.Copy after:=ThisWorkbook.Worksheets(ShCount)
Workbooks(Filename).Close savechanges:=False
For Each Sh In Worksheets
Sh.Visible = True
Next
End If
End Sub2.指定したフォルダ内のファイルをすべて読み込む
フォルダを直接指定してファイルを読み込む
Sub Sample4()
Dim Filename As String
Dim IsBookOpen As Boolean
Dim OpenBook As Workbook
Dim ShCount As Long
With CreateObject("WScript.Shell")
.CurrentDirectory = "C:\Sample\"
End With
Filename = Dir("*.xlsx")
Do While Filename <> ""
If Filename <> ThisWorkbook.Name Then
IsBookOpen = False
For Each OpenBook In Workbooks
If OpenBook.Name = Filename Then
IsBookOpen = True
Exit For
End If
Next
If IsBookOpen = False Then
ShCount = ThisWorkbook.Worksheets.Count
Workbooks.Open (Filename), UpdateLinks:=1
Worksheets.Copy after:=ThisWorkbook.Worksheets(ShCount)
Workbooks(Filename).Close savechanges:=False
End If
End If
Filename = Dir()
Loop
End Subダイアログで指定したフォルダ内のファイルをすべて読み込む
Sub Sample5()
Dim Filename As String
Dim IsBookOpen As Boolean
Dim OpenBook As Workbook
Dim myFolder As Variant
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show <> 0 Then
myFolder = .SelectedItems(1)
End If
End With
With CreateObject("WScript.Shell")
.CurrentDirectory = myFolder
End With
Filename = Dir("*.xlsx")
Do While Filename <> ""
If Filename <> ThisWorkbook.Name Then
IsBookOpen = False
For Each OpenBook In Workbooks
If OpenBook.Name = Filename Then
IsBookOpen = True
Exit For
End If
Next
If IsBookOpen = False Then
Workbooks.Open (Filename), UpdateLinks:=1
Worksheets.Copy after:=ThisWorkbook.Worksheets(ShCount)
Workbooks(Filename).Close savechanges:=False
End If
End If
Filename = Dir()
Loop
End Sub3.CSVファイルを読み込む
書式を指定せず読み込むサンプルコード
※下記コードでは「001」は「1」になります。
Sub Sample6()
Dim FileNum As Integer
Dim i As Integer
Dim n As Integer
Dim myStr() As String
Dim myRec As String
FileNum = FreeFile
i = 0
Open "C:\Sample\Book1.csv" For Input As #FileNum
Do While Not EOF(FileNum)
i = i + 1
Line Input #FileNum, myRec
myStr = Split(myRec, ",")
For n = 0 To UBound(myStr)
Cells(i, n + 1) = myStr(n)
Next n
Loop
Close #FileNum
End Sub書式を指定して読み込むサンプルコード
次のコードの「Columns(1).NumberFormat = “@”」の書式を便宜変える事で、日付や数値等ほかの書式にする事も出来ます。
また、連続した複数列を指定する場合は「Range(“A:D”).NumberFormat = “@”」と書くことも出来ます。
Sub Sample7()
Dim FileNum As Integer
Dim i As Integer
Dim n As Integer
Dim myStr() As String
Dim myRec As String
FileNum = FreeFile
i = 0
Open "C:\Sample\Book1.csv" For Input As #FileNum
Columns(1).NumberFormat = "@"
Do While Not EOF(FileNum)
i = i + 1
Line Input #FileNum, myRec
myStr = Split(myRec, ",")
Range(Cells(i, 1), Cells(i, UBound(myStr) + 1)) = myStr
Loop
Close #FileNum
End Sub4.高速でCSVファイルを読み込む
高速でCSVファイルを読み込むために配列を使用しています。
文字区切り後の列数が動的に変化しても対応出来るようにしています。
Sub Sample8()
Dim FileNum As Long
Dim i As Long
Dim n As Long
Dim myStr() As String
Dim myRec As String
Dim FSO As Object
Dim TargetFile As String
Dim FileRow As Long
Dim csvArray() As Variant
Dim MaxCol As Long
TargetFile = "C:\Sample\Book1.csv"
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO.OpenTextFile(TargetFile, 8)
FileRow = .Line
.Close
End With
Set FSO = Nothing
FileNum = FreeFile
i = 0
MaxCol = 0
Open TargetFile For Input As #FileNum
Range("A:F").NumberFormat = "@"
Do While Not EOF(FileNum)
Line Input #FileNum, myRec
myStr = Split(myRec, ",")
If MaxCol < UBound(myStr) Then MaxCol = UBound(myStr)
ReDim Preserve csvArray(0 To FileRow, 0 To MaxCol)
For n = 0 To UBound(myStr)
csvArray(i, n) = myStr(n)
Next n
i = i + 1
Loop
Range(Cells(1, 1), Cells(FileRow + 1, MaxCol + 1)) = csvArray
Close #FileNum
End Sub
