teratail header banner
teratail header banner
質問するログイン新規登録

質問編集履歴

2

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

2019/10/14 04:20

投稿

Jonny_dayo
Jonny_dayo

スコア48

title CHANGED
File without changes
body CHANGED
@@ -99,4 +99,8 @@
99
99
  ```
100
100
  ところどころコメントのみになっている箇所はこれからコードを書く予定の場所です…
101
101
  ### ツールのバージョン
102
- Excel 2016
102
+ Excel 2016
103
+
104
+ ### 追記
105
+ やりたいことを画像化したものが下記図です。(tatsu99さんありがとうございます)
106
+ ![イメージ説明](d07b54d91d8902a9bfbe067098d57ae7.png)

1

全文を追記しました

2019/10/14 04:20

投稿

Jonny_dayo
Jonny_dayo

スコア48

title CHANGED
File without changes
body CHANGED
@@ -15,6 +15,88 @@
15
15
  .Range("B" & MaxRow).Value = openBook.Worksheets(1).Range("AA9:AA13").Value
16
16
  End With
17
17
  ```
18
+ ### 全文
19
+ ```ここに言語を入力
20
+ Option Explicit
18
21
 
22
+ Sub import_excel()
23
+
24
+ '最終行を変数に取得
25
+ Dim MaxRow As Integer
26
+ MaxRow = Worksheets("2019年10月").Cells(Rows.Count, 1).End(xlUp).Row + 2
27
+
28
+ Dim arrayPath As Variant
29
+ arrayPath = Application.GetOpenFilename("ブック, *.xlsm", MultiSelect:=True)
30
+
31
+ If IsArray(arrayPath) Then
32
+
33
+ MsgBox "ちょっと時間かかるかも(´;ω;`)"
34
+
35
+ '画面の描画を停止する
36
+ Application.ScreenUpdating = False
37
+
38
+ 'Forループ(iが1から配列の要素数まで)
39
+ Dim i As Integer
40
+ For i = 1 To UBound(arrayPath)
41
+
42
+ '変数を用意し、ブックを開いて格納
43
+ Dim openBook As Workbook
44
+ Set openBook = Workbooks.Open(arrayPath(i))
45
+
46
+ 'セルの結合を解除する
47
+ Cells.Select
48
+ Selection.UnMerge
49
+
50
+ '必要項目をコピーしてくる
51
+ 'テーマ ’A3からスタートし、
52
+ With Workbooks("管理表VBA").Worksheets("2019年10月")
53
+ .Range("A" & MaxRow).Value = openBook.Worksheets(1).Range("E6").Value
54
+
55
+ '取引先への支払い金額
56
+ 'AA9~AA13、AA14は総額
57
+ '発注決定額を6行分B列に入れる
58
+ 'nilがあればそこは入力しない
59
+ '1~5のデータの総数が1であれば6列目は入れない
60
+ .Range("B" & MaxRow).Value = openBook.Worksheets(1).Range("AA9").Value
61
+
62
+ '取引先
63
+ 'ブレーンの文字を6行分D列に入れる
64
+ .Range("D" & MaxRow).Value = openBook.Worksheets(1).Range("S9:S13").Value
65
+
66
+ Next
67
+ 'nilがあればそこは入力しない
68
+ '1~5のデータの総数が1であれば6列目は入れない
69
+
70
+ '内制費
71
+ 'D列の最後の行の横E列に内制費を入れる
72
+
73
+ '見積もり総額
74
+
75
+ '担当営業
76
+ .Range("G" & MaxRow).Value = openBook.Worksheets(1).Range("B4").Value
77
+
78
+ 'A列とG列はB列の最初と最後のセルに合わせて結合する
79
+ End With
80
+
81
+ 'エクセルファイルを保存せず閉じる
82
+ Application.DisplayAlerts = False
83
+ openBook.Close
84
+
85
+ '全てのエクセルファイルに同処理をする
86
+ MaxRow = MaxRow + 2
87
+
88
+ Next i
89
+
90
+ '画面の描画を再開する
91
+ Application.ScreenUpdating = True
92
+
93
+ MsgBox "おわたよ(`・ω・´)"
94
+
95
+ End If
96
+
97
+ End Sub
98
+
99
+ ```
100
+ ところどころコメントのみになっている箇所はこれからコードを書く予定の場所です…
19
101
  ### ツールのバージョン
20
102
  Excel 2016