Excel VBA ファイルを読み込む4つの方法と8つのひな形

ファイル/フォルダ操作

今回は、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 Sub

2.指定したフォルダ内のファイルをすべて読み込む

フォルダを直接指定してファイルを読み込む

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 Sub

3.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 Sub

4.高速で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

タイトルとURLをコピーしました