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

質問編集履歴

3

コード全体の追加

2020/09/19 04:12

投稿

icecleam
icecleam

スコア46

title CHANGED
File without changes
body CHANGED
@@ -4,6 +4,7 @@
4
4
  別の変数を用意して、mとnを別でループさせたいのですが書き方がわからずうまく実装できませんでしたので、その書き方を教えていただきたいです。
5
5
  よろしくお願いします。
6
6
 
7
+ コード全体の大まかな仕様と、ソースは最下部に参考として、載せておきます。(参考までに)
7
8
 
8
9
  code1
9
10
  ```Macro
@@ -32,4 +33,94 @@
32
33
  ```Macro
33
34
  wsSet.Cells(lngRowsNo, 3).Value = .Cells(i + 3, 3).Value '②
34
35
  i = i + 1
35
- ```
36
+ ```
37
+
38
+ コード全体
39
+ ```Macro
40
+ Sub sample1()
41
+
42
+ Dim lngRowsNo As Long ' 書きこむ位置
43
+ Dim lngSheetIndex As Long ' シートの番号
44
+ Dim strFile As String ' Excelファイルの場所
45
+ Dim xlsAcq As New Excel.Application ' 取得側Excel
46
+ Dim wbAcq As Workbook ' 取得側Excelブック
47
+ Dim wsAcq As Worksheet ' 取得側Excelシート
48
+ Dim wsSet As Worksheet ' 設定側Excelシート
49
+ Const strPath As String = "パスの指定"
50
+ Set wsSet = ActiveSheet
51
+ Dim i As Long
52
+
53
+
54
+ strFile = Dir(strPath & "*.xls")
55
+ lngRowsNo = 2
56
+ Do Until strFile = ""
57
+ '----- Excelブックを開く
58
+ Set wbAcq = Workbooks.Open(strPath & strFile)
59
+
60
+ '----- シートを検索
61
+ For lngSheetIndex = 1 To wbAcq.Worksheets.Count
62
+ '----- 「更新」シートを検索
63
+ If wbAcq.Worksheets(lngSheetIndex).Name = "更新" Then
64
+ '----- 「更新」シートを変数へ登録
65
+ Set wsAcq = wbAcq.Worksheets(lngSheetIndex)
66
+ '----- 「更新」シートの内容を現在のシートにコピー(自由に変更して下さい)
67
+ With wsAcq
68
+ Dim n As Long 'ループで使用します。
69
+ Dim m As Long 'ループで使用します。
70
+ Dim ec1 As Long '各開発の一番下の担当者のセルを取得
71
+
72
+ For i = 1 To .UsedRange.Rows.Count
73
+
74
+ If Left(.Cells(i, 2).Value, 2) = "開発" Then
75
+
76
+ ' ------ 開発〇から一番上の担当者のセル位置を相対的にCells(i + 3, 3)として取得し
77
+ 'データの入っているところまでループさせる (その時、開発名を転記)
78
+
79
+ ec1 = .Cells(i + 3, 3).End(xlDown).Row
80
+ For n = i + 3 To ec1
81
+
82
+ wsSet.Cells(lngRowsNo, 2).Value = .Cells(i, 2).Value
83
+
84
+ For m = i + 3 To ec1
85
+ wsSet.Cells(lngRowsNo, 3).Value = .Cells(i + 3, 3).Value
86
+ Next m
87
+
88
+
89
+ lngRowsNo = lngRowsNo + 1
90
+
91
+ Next n
92
+
93
+ End If
94
+ Next i
95
+ End With
96
+ '----- 書きこむ位置移動
97
+
98
+ '----- 検索の終了
99
+ Exit For
100
+ End If
101
+ Next lngSheetIndex
102
+
103
+ '----- シート参照の解放
104
+ Set wsAcq = Nothing
105
+ '----- ブックを閉じる
106
+ wbAcq.Close Savechanges:=False
107
+ '----- 次のファイルへ
108
+ strFile = Dir()
109
+ Loop
110
+
111
+ '----- Excelへの参照の解放
112
+ Set xlsAcq = Nothing
113
+
114
+ End Sub
115
+ ```
116
+
117
+
118
+ ■マクロの概要
119
+ 以下の画像のようにブックからブックへ転記をしたいです。
120
+ その時、転記元のエクセルファイル(拡張子はxls)が格納されているフォルダを指定してそのフォルダ内のエクセルファイルすべてに対してに「更新」というシートがあるときだけ以下の画像のように転記を実行したいです。(現在は作成途中で担当者を転記先のように転記したいです。)
121
+
122
+ 転記元
123
+ ![転記元](d8e88eaf75129b0813b2d93a294a162d.png)
124
+
125
+ 転記先
126
+ ![転記先](e51ba7b98d24dd2c5f9ea2831d9e1e19.png)

2

内容の修正

2020/09/19 04:12

投稿

icecleam
icecleam

スコア46

title CHANGED
File without changes
body CHANGED
@@ -1,13 +1,7 @@
1
1
  以下のコードcode1で①のnの値に干渉せずに②のi+3をループさせたいです。
2
-
3
-
4
- ```Macro
5
- wsSet.Cells(lngRowsNo, 3).Value = .Cells(i + 3, 3).Value '②
6
- i = i + 1
7
- ```
8
2
 
9
- 一度上記のように記載したのですが、もちろんそれだと①のnも同時に+1されてしまいます。
3
+ 一度code2のように記載したのですが、もちろんそれだと①のnも同時に+1されてしまいます。
10
- 別の変数を用意して、ループさせる方法を試そうとしたのですが(その際に m を使いました)書き方がわからずうまく実装できませんでしたので、その書き方を教えていただきたいです。
4
+ 別の変数を用意して、mとnを別でループさせたのですが書き方がわからずうまく実装できませんでしたので、その書き方を教えていただきたいです。
11
5
  よろしくお願いします。
12
6
 
13
7
 
@@ -23,11 +17,19 @@
23
17
  wsSet.Cells(lngRowsNo, 2).Value = .Cells(i, 2).Value
24
18
 
25
19
 
20
+ For m = i + 3 To ec1
26
- wsSet.Cells(lngRowsNo, 3).Value = .Cells(i + 3, 3).Value '②
21
+ wsSet.Cells(lngRowsNo, 3).Value = .Cells(i + 3, 3).Value '②
22
+ Next m
27
23
 
28
24
 
29
25
  lngRowsNo = lngRowsNo + 1
30
26
 
31
27
  Next n
32
28
 
29
+ ```
30
+
31
+ code2
32
+ ```Macro
33
+ wsSet.Cells(lngRowsNo, 3).Value = .Cells(i + 3, 3).Value '②
34
+ i = i + 1
33
35
  ```

1

内容の修正

2020/09/19 04:03

投稿

icecleam
icecleam

スコア46

title CHANGED
File without changes
body CHANGED
@@ -1,4 +1,4 @@
1
- 以下のコードで①のnの値に干渉せずに②のi+3をループさせたいです。
1
+ 以下のコードcode1で①のnの値に干渉せずに②のi+3をループさせたいです。
2
2
 
3
3
 
4
4
  ```Macro
@@ -11,7 +11,7 @@
11
11
  よろしくお願いします。
12
12
 
13
13
 
14
-
14
+ code1
15
15
  ```Macro
16
16
  With wsAcq
17
17
  Dim n As Long 'ループで使用します。