質問編集履歴
3
コード全体の追加
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
|
+

|
124
|
+
|
125
|
+
転記先
|
126
|
+

|
2
内容の修正
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
|
-
一度
|
3
|
+
一度code2のように記載したのですが、もちろんそれだと①のnも同時に+1されてしまいます。
|
10
|
-
別の変数を用意して、ループさせ
|
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
|
-
|
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
内容の修正
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 'ループで使用します。
|