質問編集履歴

2

やりたいことの画像データを追記しました!

2019/10/14 04:20

投稿

Jonny_dayo
Jonny_dayo

スコア48

test CHANGED
File without changes
test CHANGED
@@ -201,3 +201,11 @@
201
201
  ### ツールのバージョン
202
202
 
203
203
  Excel 2016
204
+
205
+
206
+
207
+ ### 追記
208
+
209
+ やりたいことを画像化したものが下記図です。(tatsu99さんありがとうございます)
210
+
211
+ ![イメージ説明](d07b54d91d8902a9bfbe067098d57ae7.png)

1

全文を追記しました

2019/10/14 04:20

投稿

Jonny_dayo
Jonny_dayo

スコア48

test CHANGED
File without changes
test CHANGED
@@ -32,7 +32,171 @@
32
32
 
33
33
  ```
34
34
 
35
-
35
+ ### 全文
36
+
37
+ ```ここに言語を入力
38
+
39
+ Option Explicit
40
+
41
+
42
+
43
+ Sub import_excel()
44
+
45
+
46
+
47
+ '最終行を変数に取得
48
+
49
+ Dim MaxRow As Integer
50
+
51
+ MaxRow = Worksheets("2019年10月").Cells(Rows.Count, 1).End(xlUp).Row + 2
52
+
53
+
54
+
55
+ Dim arrayPath As Variant
56
+
57
+ arrayPath = Application.GetOpenFilename("ブック, *.xlsm", MultiSelect:=True)
58
+
59
+
60
+
61
+ If IsArray(arrayPath) Then
62
+
63
+
64
+
65
+ MsgBox "ちょっと時間かかるかも(´;ω;`)"
66
+
67
+
68
+
69
+ '画面の描画を停止する
70
+
71
+ Application.ScreenUpdating = False
72
+
73
+
74
+
75
+ 'Forループ(iが1から配列の要素数まで)
76
+
77
+ Dim i As Integer
78
+
79
+ For i = 1 To UBound(arrayPath)
80
+
81
+
82
+
83
+ '変数を用意し、ブックを開いて格納
84
+
85
+ Dim openBook As Workbook
86
+
87
+ Set openBook = Workbooks.Open(arrayPath(i))
88
+
89
+
90
+
91
+ 'セルの結合を解除する
92
+
93
+ Cells.Select
94
+
95
+ Selection.UnMerge
96
+
97
+
98
+
99
+ '必要項目をコピーしてくる
100
+
101
+ 'テーマ ’A3からスタートし、
102
+
103
+ With Workbooks("管理表VBA").Worksheets("2019年10月")
104
+
105
+ .Range("A" & MaxRow).Value = openBook.Worksheets(1).Range("E6").Value
106
+
107
+
108
+
109
+ '取引先への支払い金額
110
+
111
+ 'AA9~AA13、AA14は総額
112
+
113
+ '発注決定額を6行分B列に入れる
114
+
115
+ 'nilがあればそこは入力しない
116
+
117
+ '1~5のデータの総数が1であれば6列目は入れない
118
+
119
+ .Range("B" & MaxRow).Value = openBook.Worksheets(1).Range("AA9").Value
120
+
121
+
122
+
123
+ '取引先
124
+
125
+ 'ブレーンの文字を6行分D列に入れる
126
+
127
+ .Range("D" & MaxRow).Value = openBook.Worksheets(1).Range("S9:S13").Value
128
+
129
+
130
+
131
+ Next
132
+
133
+ 'nilがあればそこは入力しない
134
+
135
+ '1~5のデータの総数が1であれば6列目は入れない
136
+
137
+
138
+
139
+ '内制費
140
+
141
+ 'D列の最後の行の横E列に内制費を入れる
142
+
143
+
144
+
145
+ '見積もり総額
146
+
147
+
148
+
149
+ '担当営業
150
+
151
+ .Range("G" & MaxRow).Value = openBook.Worksheets(1).Range("B4").Value
152
+
153
+
154
+
155
+ 'A列とG列はB列の最初と最後のセルに合わせて結合する
156
+
157
+ End With
158
+
159
+
160
+
161
+ 'エクセルファイルを保存せず閉じる
162
+
163
+ Application.DisplayAlerts = False
164
+
165
+ openBook.Close
166
+
167
+
168
+
169
+ '全てのエクセルファイルに同処理をする
170
+
171
+ MaxRow = MaxRow + 2
172
+
173
+
174
+
175
+ Next i
176
+
177
+
178
+
179
+ '画面の描画を再開する
180
+
181
+ Application.ScreenUpdating = True
182
+
183
+
184
+
185
+ MsgBox "おわたよ(`・ω・´)"
186
+
187
+
188
+
189
+ End If
190
+
191
+
192
+
193
+ End Sub
194
+
195
+
196
+
197
+ ```
198
+
199
+ ところどころコメントのみになっている箇所はこれからコードを書く予定の場所です…
36
200
 
37
201
  ### ツールのバージョン
38
202