回答編集履歴

3

修正

2020/04/27 16:18

投稿

meg_
meg_

スコア10600

test CHANGED
@@ -32,7 +32,7 @@
32
32
 
33
33
 
34
34
 
35
- For i = 4 To ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row
35
+ For i = 2 To ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row
36
36
 
37
37
  copyCheck = False
38
38
 

2

修正

2020/04/27 16:18

投稿

meg_
meg_

スコア10600

test CHANGED
@@ -32,7 +32,45 @@
32
32
 
33
33
 
34
34
 
35
- For i = 2 To ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row
35
+ For i = 4 To ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row
36
+
37
+ copyCheck = False
38
+
39
+ For j = UBound(List, 1) To 2 Step -1 'リストの下から探すため(一番新しいデータ)
40
+
41
+ If copyCheck = False Then
42
+
43
+ 'リストBの品番で検索し、ヒットしたら
44
+
45
+ If ws2.Cells(i, 2).Value = List(j, 2) Then
46
+
47
+ 'ヒットした行をコピぺ※ここで、一番新しいデータだけでなく、過去分までコピペされている
48
+
49
+ ws1.Rows(j).Copy Destination:=ws1.Rows(cnt)
50
+
51
+ copyCheck = True
52
+
53
+
54
+
55
+ If ws1.Cells(j, 4).Value = "B" Then
56
+
57
+ ws1.Cells(cnt, 4).Value = "A"
58
+
59
+ End If
60
+
61
+
62
+
63
+ ws1.Cells(cnt, 3).Value = myDate1
64
+
65
+ cnt = cnt + 1
66
+
67
+ End If
68
+
69
+ End If
70
+
71
+ Next j
72
+
73
+
36
74
 
37
75
  If copyCheck = False Then
38
76
 
@@ -40,15 +78,13 @@
40
78
 
41
79
  If copyCheck = False Then
42
80
 
43
- 'リストBの品番で検索し、ヒットしたら
81
+ 'リストBの品番ヒットしなければ、リストBの品番2で検索
44
82
 
45
- If ws2.Cells(i, 2).Value = List(j, 2) Then
83
+ If ws2.Cells(i, 3).Value = List(j, 2) Then
46
84
 
47
- 'ヒットした行をコピぺ※ここで、一番新しいデータだけでなく、過去分までコピされている
85
+ 'ヒットした行をコピペ
48
86
 
49
87
  ws1.Rows(j).Copy Destination:=ws1.Rows(cnt)
50
-
51
- copyCheck = True
52
88
 
53
89
 
54
90
 
@@ -58,11 +94,9 @@
58
94
 
59
95
  End If
60
96
 
97
+ copyCheck = True
61
98
 
62
-
63
- ws1.Cells(cnt, 3).Value = myDate1
99
+ cnt = cnt + 1
64
-
65
-
66
100
 
67
101
  End If
68
102
 
@@ -74,38 +108,6 @@
74
108
 
75
109
 
76
110
 
77
- If copyCheck = False Then
78
-
79
- For j = UBound(List, 1) To 2 Step -1 'リストの下から探すため(一番新しいデータ)
80
-
81
- 'リストBの品番がヒットしなければ、リストBの品番2で検索
82
-
83
- If ws2.Cells(i, 3).Value = List(j, 2) Then
84
-
85
- 'ヒットした行をコピペ
86
-
87
- ws1.Rows(j).Copy Destination:=ws1.Rows(cnt)
88
-
89
-
90
-
91
- If ws1.Cells(j, 4).Value = "B" Then
92
-
93
- ws1.Cells(cnt, 4).Value = "A"
94
-
95
- End If
96
-
97
- End If
98
-
99
- Next j
100
-
101
- End If
102
-
103
-
104
-
105
- cnt = cnt + 1
106
-
107
-
108
-
109
111
  Next i
110
112
 
111
113
  End Sub

1

修正

2020/04/27 16:17

投稿

meg_
meg_

スコア10600

test CHANGED
@@ -12,13 +12,13 @@
12
12
 
13
13
  Dim List, cnt As Long, i As Long, j As Long
14
14
 
15
- Dim copyCheck as Boolean
15
+ Dim copyCheck As Boolean
16
16
 
17
17
 
18
18
 
19
19
  Set ws1 = Worksheets("リストA")
20
20
 
21
- Set ws2 = Worksheets("リストB")
21
+ Set ws2 = Worksheets("リストB")
22
22
 
23
23
  myDate1 = ws2.Range("B2")
24
24
 
@@ -28,27 +28,63 @@
28
28
 
29
29
  List = ws1.Range("A1").CurrentRegion
30
30
 
31
- cnt = UBound(List, 1) + 1
31
+ cnt = UBound(List, 1) + 1
32
32
 
33
33
 
34
34
 
35
35
  For i = 2 To ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row
36
36
 
37
- copyCheck = False Then
37
+ If copyCheck = False Then
38
38
 
39
- For j = UBound(List, 1) To 2 Step -1  ’リストの下から探すため(一番新しいデータ)
39
+ For j = UBound(List, 1) To 2 Step -1 'リストの下から探すため(一番新しいデータ)
40
40
 
41
- If copyCheck = False Then
41
+ If copyCheck = False Then
42
42
 
43
- リストBの品番で検索し、ヒットしたら
43
+ 'リストBの品番で検索し、ヒットしたら
44
44
 
45
- If ws2.Cells(i, 2).Value = List(j, 2) Then
45
+ If ws2.Cells(i, 2).Value = List(j, 2) Then
46
46
 
47
- ヒットした行をコピぺ※ここで、一番新しいデータだけでなく、過去分までコピペされている
47
+ 'ヒットした行をコピぺ※ここで、一番新しいデータだけでなく、過去分までコピペされている
48
+
49
+ ws1.Rows(j).Copy Destination:=ws1.Rows(cnt)
50
+
51
+ copyCheck = True
52
+
53
+
54
+
55
+ If ws1.Cells(j, 4).Value = "B" Then
56
+
57
+ ws1.Cells(cnt, 4).Value = "A"
58
+
59
+ End If
60
+
61
+
62
+
63
+ ws1.Cells(cnt, 3).Value = myDate1
64
+
65
+
66
+
67
+ End If
68
+
69
+ End If
70
+
71
+ Next j
72
+
73
+ End If
74
+
75
+
76
+
77
+ If copyCheck = False Then
78
+
79
+ For j = UBound(List, 1) To 2 Step -1 'リストの下から探すため(一番新しいデータ)
80
+
81
+ 'リストBの品番がヒットしなければ、リストBの品番2で検索
82
+
83
+ If ws2.Cells(i, 3).Value = List(j, 2) Then
84
+
85
+ 'ヒットした行をコピペ
48
86
 
49
87
  ws1.Rows(j).Copy Destination:=ws1.Rows(cnt)
50
-
51
- copyCheck = True
52
88
 
53
89
 
54
90
 
@@ -58,45 +94,11 @@
58
94
 
59
95
  End If
60
96
 
61
-
62
-
63
- ws1.Cells(cnt, 3).Value = myDate1
64
-
65
-
66
-
67
97
  End If
68
98
 
69
- End If
99
+ Next j
70
100
 
71
- Next j
72
-
73
-
74
-
75
- If copyCheck = False Then
76
-
77
- For j = UBound(List, 1) To 2 Step -1  ’リストの下から探すため(一番新しいデータ)
78
-
79
- ’リストBの品番がヒットしなければ、リストBの品番2で検索
80
-
81
- If ws2.Cells(i, 3).Value = List(j, 2) Then
82
-
83
- ’ヒットした行をコピペ
84
-
85
- ws1.Rows(j).Copy Destination:=ws1.Rows(cnt)
86
-
87
-
88
-
89
- If ws1.Cells(j, 4).Value = "B" Then
90
-
91
- ws1.Cells(cnt, 4).Value = "A"
92
-
93
- End If
101
+ End If
94
-
95
- End If
96
-
97
- Next j
98
-
99
- End If
100
102
 
101
103
 
102
104
 
@@ -106,10 +108,6 @@
106
108
 
107
109
  Next i
108
110
 
109
- End If
110
-
111
-
112
-
113
111
  End Sub
114
112
 
115
113
  ```