回答編集履歴

5

こちらかがいいかも

2020/07/29 08:14

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1 +1,11 @@
1
- コメント無駄なので削除してきます。
1
+ ~~コメント無駄なので削除してきます。~~
2
+
3
+
4
+
5
+ ご覧になられたのかわからないので、UPしておきます(あくまでサンプルです)。
6
+
7
+ エクセルファイルが、data1,data2とあり、data1のマクロを実行してみてください。
8
+
9
+
10
+
11
+ [データ便に3日間載せておきます。](https://www.datadeliver.net/receiver/file_box.do?fb=6b9373f1f28541dca067cfe3b1c63c24&rc=8a408639f6454cc595f03b09318519a7&lang=ja)

4

削除

2020/07/29 08:14

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1,147 +1 @@
1
- 皆様の厳しい意見もありますが、あくまでもサンプルということでお許しください。
2
-
3
-
4
-
5
- 各シートの準備は下記の通りです。
1
+ コメン無駄なので削除してきます。
6
-
7
-
8
-
9
- data1.xlsm(データ元) シート名:data1
10
-
11
- data2.xlsm(転記先) シート名:data2
12
-
13
-
14
-
15
- を準備します(data1.xlsmにマクロを記述します)。
16
-
17
- (※data2.xlsmの拡張子はマクロがないので通常でかまいません)
18
-
19
-
20
-
21
- サンプルとなりますので、ご自身で検証をお願いします。
22
-
23
-
24
-
25
- ```VBA
26
-
27
- Sub test()
28
-
29
- Dim FolderPath As String
30
-
31
- Dim Filename As String
32
-
33
- Dim excellist As String
34
-
35
- Dim MaxRow1 As Long
36
-
37
- Dim MaxRow2 As Long
38
-
39
- Dim i As Double
40
-
41
- Dim str As String
42
-
43
- Dim ロットNO As String
44
-
45
-
46
-
47
- 'Excelファイルを開く
48
-
49
-
50
-
51
- FolderPath = ThisWorkbook.Path & "\"
52
-
53
-
54
-
55
- Filename = "data2.xlsm"
56
-
57
-
58
-
59
- excellist = FolderPath & Filename
60
-
61
-
62
-
63
- Set wb = Workbooks.Open(excellist)
64
-
65
-
66
-
67
- MaxRow2 = wb.Sheets("data2").Cells(Rows.Count, 1).End(xlUp).Row
68
-
69
-
70
-
71
-
72
-
73
- MaxRow1 = ThisWorkbook.Sheets("data1").Cells(Rows.Count, 1).End(xlUp).Row
74
-
75
-
76
-
77
- For i = 2 To MaxRow1
78
-
79
-
80
-
81
- With ThisWorkbook.Sheets("data1")
82
-
83
-
84
-
85
- str = Mid(.Range("A" & i).Value, 2, 1)
86
-
87
-
88
-
89
- If str = "X" Then
90
-
91
-
92
-
93
- ロットNO = .Range("A" & i).Value
94
-
95
-
96
-
97
-
98
-
99
- cnt = WorksheetFunction.CountIf(wb.Sheets("data2").Range("A:A"), ロットNO)
100
-
101
-
102
-
103
- If cnt = 0 Then
104
-
105
- MaxRow2 = MaxRow2 + 1
106
-
107
-
108
-
109
- wb.Sheets("data2").Range("A" & MaxRow2).Value = ロットNO
110
-
111
- wb.Sheets("data2").Range("B" & MaxRow2).Value = .Range("B" & i).Value
112
-
113
- wb.Sheets("data2").Range("C" & MaxRow2).Value = .Range("C" & i).Value
114
-
115
-
116
-
117
- End If
118
-
119
- End If
120
-
121
-
122
-
123
- End With
124
-
125
-
126
-
127
- Next
128
-
129
-
130
-
131
- set wb = nothing
132
-
133
-
134
-
135
- End Sub
136
-
137
- ```
138
-
139
-
140
-
141
- 下記URLのデータ便に圧縮ファイルをUPしておきました。
142
-
143
- ダウンロード期間は1日となります(あやしいサイトではありません)。
144
-
145
-
146
-
147
- https://www.datadeliver.net/receiver/file_box.do?fb=b70e3c0f1ad94818bae764c24ca18df5&rc=761752791e034578a520d9181da9bdb8&lang=ja

3

こちらかがいいかも

2020/07/28 23:35

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -128,6 +128,10 @@
128
128
 
129
129
 
130
130
 
131
+ set wb = nothing
132
+
133
+
134
+
131
135
  End Sub
132
136
 
133
137
  ```

2

こちらかがいいかも

2020/07/28 09:39

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1,3 +1,7 @@
1
+ 皆様の厳しい意見もありますが、あくまでもサンプルということでお許しください。
2
+
3
+
4
+
1
5
  各シートの準備は下記の通りです。
2
6
 
3
7
 
@@ -127,3 +131,13 @@
127
131
  End Sub
128
132
 
129
133
  ```
134
+
135
+
136
+
137
+ 下記URLのデータ便に圧縮ファイルをUPしておきました。
138
+
139
+ ダウンロード期間は1日となります(あやしいサイトではありません)。
140
+
141
+
142
+
143
+ https://www.datadeliver.net/receiver/file_box.do?fb=b70e3c0f1ad94818bae764c24ca18df5&rc=761752791e034578a520d9181da9bdb8&lang=ja

1

こちらかがいいかも

2020/07/28 09:20

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -13,6 +13,8 @@
13
13
  (※data2.xlsmの拡張子はマクロがないので通常でかまいません)
14
14
 
15
15
 
16
+
17
+ サンプルとなりますので、ご自身で検証をお願いします。
16
18
 
17
19
 
18
20