[MSOffice:ExcelVBA]エクセル操作

サンプルコード

要件

任意パスにあるエクセルの全シート分の特定のセルの値を抽出し、一覧化する。

処理概要

[前提]任意のパスをSheet1に記載
①Sheet1に記載のあるパスのエクセルを読み込む
②①で読み込んだ情報をSheet2へ出力

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
Sub SelectExcelInfo()
 
    '変数の宣言
    Dim aRx As Integer
    Dim aRy As Integer
    Dim aTx As Integer
    Dim aTy As Integer
    Dim aWx1 As Integer
    Dim aWx2 As Integer
    Dim aWy As Integer
    Dim aShtCnt As Integer
 
 
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
 
    Dim aFullPath As String
    Dim aFileName As String
    Dim aClrArea As String
 
    '初期化--任意の設定
    '--読込
    aRx = 1
    aRy = 1
    '--対象
    aTx = 1
    aTy = 1
    '--書込
    aWx1 = 1
    aWx2 = 2
    aWy = 1
    aClrArea = "A1:A1000"
    '初期化--固定
    i = 1
    j = 1
    k = 1
    '初期処理
    Sheet2.Range(aClrArea).ClearContents
 
    'メイン処理
    Do
        With Sheet1
            If .Cells(aRy, aRx).Value = "" Then
                Exit Do
            End If
            aFullPath = .Cells(aRy, aRx).Value
        End With
        aFileName = Mid(aFullPath, InStrRev(aFullPath, "\") + 1)
        Workbooks.Open Filename:=aFullPath, ReadOnly:=True
        aShtCnt = Workbooks(aFileName).Worksheets.Count
        j = 1
        Do Until j > aShtCnt
            With Workbooks(aFileName).Worksheets(j)
                Sheet2.Cells(aWy, aWx1).Value = .Name
                Sheet2.Cells(aWy, aWx2).Value = .Cells(aTy, aTx).Value
            End With
            j = j + 1
            aWy = j
        Loop
        Workbooks(aFileName).Close SaveChanges:=False
        i = i + 1
        aRy = i
    Loop
    MsgBox ("finish!!")
End Sub

参考資料

Workbooks Object

URL:Workbooks Object[Excel 2013 Developer Reference]

つぶやき

大量のエクセルの任意の場所を比較するときは活躍します😁