teratail
回答率
85.47%
質問するログイン新規登録
トップに関する質問VBA　同じ値が複数回でてくる場合の転記

編集履歴

質問編集履歴

7

追記

2019/07/11 04:58

投稿

mi07
mi07

スコア20

test CHANGED
File without changes
test CHANGED
@@ -1,20 +1,20 @@
1
- 以前、以下の式を教えていただきましたが、
1
+ 以下の数式において、
2
2
 
3
- データ移行シートのI列2-7行の間に同じ値が複数回ある場合があり、その場合、この式ではうまく代入ができません。
3
+ データ移行シートのI列2-7行の間に同じ値が複数回ある場合があり、
4
4
 
5
- 複数回出てくる場合は、それぞれ（２行なら２行、３行なら３行）そのまま転記できるようにしたいのですが、お力添えいただけますでしょうか？
5
+ その場合、この式ではうまく代入ができません。
6
6
 
7
7
 
8
8
 
9
9
  データ移行シートI2のシートの値と同じシート名のシートの最終行に、データ移行シートのA2-D2,F2-G2の値を代入し、それをI2-I7まで繰り返すという作業です。
10
10
 
11
- Iの値は、空白の場合もあり、エラーをスキップするという式を教えていただきました。
11
+ Iの値は、空白の場合もあり、エラーをスキップします。
12
12
 
13
13
 
14
14
 
15
15
  今回、Iの値が、２行にわたり同じ値の場合もある際に、転記できるようにしたいです。
16
16
 
17
-
17
+ お力添えいただけますでしょうか？
18
18
 
19
19
  よろしくお願いいたします。
20
20
 

6

追記

2019/07/11 04:58

投稿

mi07
mi07

スコア20

test CHANGED
File without changes
test CHANGED
@@ -22,7 +22,7 @@
22
22
 
23
23
 
24
24
 
25
- ```
25
+ ```VBA
26
26
 
27
27
 
28
28
 

5

追記

2019/07/11 03:52

投稿

mi07
mi07

スコア20

test CHANGED
File without changes
test CHANGED
@@ -22,7 +22,11 @@
22
22
 
23
23
 
24
24
 
25
+ ```
26
+
27
+
28
+
25
- ```Public Sub 転記回答②()
29
+ Public Sub 転記回答②()
26
30
 
27
31
  Dim wrow As Long
28
32
 
@@ -66,4 +70,6 @@
66
70
 
67
71
  コード
68
72
 
73
+
74
+
69
75
  ```

4

追記

2019/07/11 03:51

投稿

mi07
mi07

スコア20

test CHANGED
@@ -1 +1 @@
1
- 同じ値が複数回でてくる場合の転記
1
+ VBA　同じ値が複数回でてくる場合の転記
test CHANGED
File without changes

3

誤字

2019/07/11 03:48

投稿

mi07
mi07

スコア20

test CHANGED
File without changes
test CHANGED
@@ -1,14 +1,8 @@
1
1
  以前、以下の式を教えていただきましたが、
2
2
 
3
- データ移行シートのI列2-7行の間に同じ値が複数回ある場合があります。
3
+ データ移行シートのI列2-7行の間に同じ値が複数回ある場合があり、その場合、この式ではうまく代入ができません。
4
-
5
-
6
-
7
- その場合、この式ではうまく代入ができません。
8
4
 
9
5
  複数回出てくる場合は、それぞれ（２行なら２行、３行なら３行）そのまま転記できるようにしたいのですが、お力添えいただけますでしょうか？
10
-
11
- よろしくお願いいたします。
12
6
 
13
7
 
14
8
 

2

追記

2019/07/11 03:47

投稿

mi07
mi07

スコア20

test CHANGED
File without changes
test CHANGED
@@ -1,12 +1,26 @@
1
1
  以前、以下の式を教えていただきましたが、
2
2
 
3
- データ移行シートのI列2-7行の間に同じ値が複数回出ていく可能性が出てきました。
3
+ データ移行シートのI列2-7行の間に同じ値が複数回ある場合があります。
4
4
 
5
5
 
6
6
 
7
- その場合、うまく値の代入ができないのですが、、、
7
+ その場合、この式ではうまく代入ができません。
8
8
 
9
9
  複数回出てくる場合は、それぞれ（２行なら２行、３行なら３行）そのまま転記できるようにしたいのですが、お力添えいただけますでしょうか？
10
+
11
+ よろしくお願いいたします。
12
+
13
+
14
+
15
+ データ移行シートI2のシートの値と同じシート名のシートの最終行に、データ移行シートのA2-D2,F2-G2の値を代入し、それをI2-I7まで繰り返すという作業です。
16
+
17
+ Iの値は、空白の場合もあり、エラーをスキップするという式を教えていただきました。
18
+
19
+
20
+
21
+ 今回、Iの値が、２行にわたり同じ値の場合もある際に、転記できるようにしたいです。
22
+
23
+
10
24
 
11
25
  よろしくお願いいたします。
12
26
 

1

記載法変更

2019/07/11 03:45

投稿

mi07
mi07

スコア20

test CHANGED
File without changes
test CHANGED
@@ -14,42 +14,48 @@
14
14
 
15
15
 
16
16
 
17
- Public Sub 転記回答②()
17
+ ```Public Sub 転記回答②()
18
18
 
19
- Dim wrow As Long
19
+ Dim wrow As Long
20
20
 
21
- Dim ws1 As Worksheet 'データ移行シートI2の値のシートの最終行にA2:D2とF2：G2の値代入
21
+ Dim ws1 As Worksheet 'データ移行シートI2の値のシートの最終行にA2:D2とF2：G2の値代入
22
22
 
23
- Set ws1 = Sheets("データ移行")
23
+ Set ws1 = Sheets("データ移行")
24
24
 
25
25
 
26
26
 
27
- Dim ws2 As Worksheet
27
+ Dim ws2 As Worksheet
28
28
 
29
- For wrow = 2 To 7
29
+ For wrow = 2 To 7
30
30
 
31
- 'エラーのセルはスキップする
31
+ 'エラーのセルはスキップする
32
32
 
33
- If IsError(ws1.Cells(wrow, "I").Value) = False Then
33
+ If IsError(ws1.Cells(wrow, "I").Value) = False Then
34
34
 
35
- Set ws2 = Sheets(ws1.Cells(wrow, "I").Value)
35
+ Set ws2 = Sheets(ws1.Cells(wrow, "I").Value)
36
36
 
37
37
 
38
38
 
39
- Dim TargetRng As Range
39
+ Dim TargetRng As Range
40
40
 
41
- Set TargetRng = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
41
+ Set TargetRng = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
42
42
 
43
43
 
44
44
 
45
- TargetRng.Resize(, 4).Value = ws1.Range("A2:D2").Value
45
+ TargetRng.Resize(, 4).Value = ws1.Range("A2:D2").Value
46
46
 
47
- TargetRng.Resize(, 1).Offset(, 5).Value = ws1.Range("F2").Value
47
+ TargetRng.Resize(, 1).Offset(, 5).Value = ws1.Range("F2").Value
48
48
 
49
- End If
49
+ End If
50
50
 
51
- Next
51
+ Next
52
52
 
53
53
 
54
54
 
55
- End Sub
55
+ End Sub
56
+
57
+
58
+
59
+ コード
60
+
61
+ ```