回答編集履歴
1
変数名を整理
test
CHANGED
@@ -8,51 +8,59 @@
|
|
8
8
|
|
9
9
|
Sub sample1()
|
10
10
|
|
11
|
-
|
11
|
+
|
12
12
|
|
13
|
-
Dim s As Long '
|
13
|
+
Dim lngRowsNo As Long ' 書きこむ位置
|
14
14
|
|
15
|
-
Dim
|
15
|
+
Dim lngSheetIndex As Long ' シートの番号
|
16
16
|
|
17
|
-
Dim
|
17
|
+
Dim strFile As String ' Excelファイルの場所
|
18
18
|
|
19
|
-
Dim
|
19
|
+
Dim xlsAcq As New Excel.Application ' 取得側Excel
|
20
20
|
|
21
|
-
Dim w
|
21
|
+
Dim wbAcq As Workbook ' 取得側Excelブック
|
22
22
|
|
23
|
-
|
23
|
+
Dim wsAcq As Worksheet ' 取得側Excelシート
|
24
24
|
|
25
|
-
st
|
25
|
+
Dim wsSet As Worksheet ' 設定側Excelシート
|
26
26
|
|
27
|
-
i =
|
27
|
+
Const strPath As String = "ここでフォルダのパスを指定"
|
28
28
|
|
29
|
+
Set wsSet = ActiveSheet
|
30
|
+
|
31
|
+
|
32
|
+
|
33
|
+
strFile = Dir(strPath & "*.xls")
|
34
|
+
|
35
|
+
lngRowsNo = 1
|
36
|
+
|
29
|
-
Do
|
37
|
+
Do Until strFile = ""
|
30
38
|
|
31
39
|
'----- Excelブックを開く
|
32
40
|
|
33
|
-
Set wb = xls.Workbooks.Open(Path & strFile)
|
41
|
+
Set wbAcq = xlsAcq.Workbooks.Open(strPath & strFile)
|
34
42
|
|
35
43
|
|
36
44
|
|
37
45
|
'----- シートを検索
|
38
46
|
|
39
|
-
For
|
47
|
+
For lngSheetIndex = 1 To wbAcq.Worksheets.Count
|
40
48
|
|
41
49
|
'----- 「更新」シートを検索
|
42
50
|
|
43
|
-
If wb.Worksheets(
|
51
|
+
If wbAcq.Worksheets(lngSheetIndex).Name = "更新" Then
|
44
52
|
|
45
53
|
'----- 「更新」シートを変数へ登録
|
46
54
|
|
47
|
-
Set ws =
|
55
|
+
Set wsAcq = xlsAcq.Worksheets(lngSheetIndex)
|
48
56
|
|
49
57
|
'----- 「更新」シートの内容を現在のシートにコピー(自由に変更して下さい)
|
50
58
|
|
51
|
-
Cells(
|
59
|
+
wsSet.Cells(lngRowsNo, 1) = wsAcq.Cells(1, 1)
|
52
60
|
|
53
61
|
'----- 書きこむ位置移動
|
54
62
|
|
55
|
-
|
63
|
+
lngRowsNo = lngRowsNo + 1
|
56
64
|
|
57
65
|
'----- 検索の終了
|
58
66
|
|
@@ -60,17 +68,17 @@
|
|
60
68
|
|
61
69
|
End If
|
62
70
|
|
63
|
-
Next
|
71
|
+
Next lngSheetIndex
|
64
72
|
|
65
73
|
|
66
74
|
|
67
75
|
'----- シート参照の解放
|
68
76
|
|
69
|
-
Set ws = Nothing
|
77
|
+
Set wsAcq = Nothing
|
70
78
|
|
71
79
|
'----- ブックを閉じる
|
72
80
|
|
73
|
-
wb.Close Savechanges:=False
|
81
|
+
wbAcq.Close Savechanges:=False
|
74
82
|
|
75
83
|
'----- 次のファイルへ
|
76
84
|
|
@@ -78,10 +86,18 @@
|
|
78
86
|
|
79
87
|
Loop
|
80
88
|
|
89
|
+
|
90
|
+
|
81
91
|
'----- Excelへの参照の解放
|
82
92
|
|
83
|
-
Set xls = Nothing
|
93
|
+
Set xlsAcq = Nothing
|
94
|
+
|
95
|
+
|
84
96
|
|
85
97
|
End Sub
|
86
98
|
|
99
|
+
|
100
|
+
|
101
|
+
|
102
|
+
|
87
103
|
```
|