teratail
回答率
85.35%
teratail header banner
teratail header banner
質問するログイン新規登録
トップVBAに関する質問エクセルで別シートに情報を抽出

編集履歴

回答編集履歴

6

こちらかがいいかも

2020/08/04 07:53

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -154,7 +154,9 @@
154
154
 
155
155
 
156
156
 
157
- UPしたファイルが間違っておりました。下記に修正をお願いします。
157
+ データ便にUPしたファイルが間違っておりました。下記に修正をお願いします。
158
+
159
+ 下記の部分をsh2→sh3に修正をお願いします。
158
160
 
159
161
 
160
162
 

5

こちらかがいいかも

2020/08/04 07:53

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -122,9 +122,9 @@
122
122
 
123
123
  With Sheets("Sheet3")
124
124
 
125
- .Range("A" & sh2).Value = Sheets("data").Range("B" & i) '商品
125
+ .Range("A" & sh3).Value = Sheets("data").Range("B" & i) '商品
126
126
 
127
- .Range("B" & sh2).Value = Sheets("data").Range("D" & i) '産地
127
+ .Range("B" & sh3).Value = Sheets("data").Range("D" & i) '産地
128
128
 
129
129
 
130
130
 
@@ -151,3 +151,19 @@
151
151
  End Sub
152
152
 
153
153
  ```
154
+
155
+
156
+
157
+ UPしたファイルが間違っておりました。下記に修正をお願いします。
158
+
159
+
160
+
161
+ With Sheets("Sheet3")
162
+
163
+ .Range("A" & sh3).Value = Sheets("data").Range("B" & i) '商品
164
+
165
+ .Range("B" & sh3).Value = Sheets("data").Range("D" & i) '産地
166
+
167
+
168
+
169
+ End With

4

こちらかがいいかも

2020/08/04 07:49

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -16,7 +16,9 @@
16
16
 
17
17
 
18
18
 
19
+ 例を示します。サンプルはA列が〇か×かを判定し、sheet2、sheet3に情報を転記するサンプルです。
20
+
19
- 例を示します。
21
+ 転記するリストは、商品名と産地です。
20
22
 
21
23
 
22
24
 

3

こちらかがいいかも

2020/08/04 07:46

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -12,4 +12,140 @@
12
12
 
13
13
 
14
14
 
15
- 表についてもご提示いただけるとよいかと思います
15
+ 表についてもご提示いただけるとよいかと思います。
16
+
17
+
18
+
19
+ 例を示します。
20
+
21
+
22
+
23
+ 例）Excelシート名：data、sheet2、sheet3
24
+
25
+
26
+
27
+ シート：data
28
+
29
+ A～D列
30
+
31
+ |判定|商品|価格|産地|
32
+
33
+ |:--|:--:|--:|
34
+
35
+ |〇|A|100|宮城県|
36
+
37
+ |×|B|200|山形県|
38
+
39
+ |〇|C|300|北海道|
40
+
41
+ |〇|D|400|広島県|
42
+
43
+ |〇|E|500|青森県|
44
+
45
+ |〇|F|600|沖縄県|
46
+
47
+ |〇|G|700|福島県|
48
+
49
+
50
+
51
+ ```VBA
52
+
53
+ Sub test()
54
+
55
+ Dim MaxRow As Double
56
+
57
+ Dim 判定 As String
58
+
59
+ Dim　i as Double
60
+
61
+ Dim sh2 As Double
62
+
63
+ Dim sh3 As Double
64
+
65
+
66
+
67
+
68
+
69
+ MaxRow = Sheets("data").Cells(Rows.Count, 1).End(xlUp).Row
70
+
71
+
72
+
73
+
74
+
75
+ For i = 2 To MaxRow
76
+
77
+
78
+
79
+ 判定 = Sheets("data").Range("A" & i)
80
+
81
+
82
+
83
+ If 判定 = "〇" Then
84
+
85
+
86
+
87
+ sh2 = sh2 + 1
88
+
89
+
90
+
91
+ With Sheets("Sheet2")
92
+
93
+
94
+
95
+ .Range("A" & sh2).Value = Sheets("data").Range("B" & i) '商品
96
+
97
+ .Range("B" & sh2).Value = Sheets("data").Range("D" & i) '産地
98
+
99
+
100
+
101
+ End With
102
+
103
+
104
+
105
+
106
+
107
+
108
+
109
+ ElseIf 判定 = "×" Then
110
+
111
+
112
+
113
+ sh3 = sh3 + 1
114
+
115
+
116
+
117
+
118
+
119
+
120
+
121
+ With Sheets("Sheet3")
122
+
123
+ .Range("A" & sh2).Value = Sheets("data").Range("B" & i) '商品
124
+
125
+ .Range("B" & sh2).Value = Sheets("data").Range("D" & i) '産地
126
+
127
+
128
+
129
+ End With
130
+
131
+
132
+
133
+ End If
134
+
135
+
136
+
137
+
138
+
139
+
140
+
141
+
142
+
143
+ Next
144
+
145
+
146
+
147
+
148
+
149
+ End Sub
150
+
151
+ ```

2

こちらかがいいかも

2020/08/04 07:36

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -6,4 +6,10 @@
6
6
 
7
7
 
8
8
 
9
+ >>xmlファイルからエクセルシートへの読み取りまでは出来ました。
10
+
11
+ →手作業でしょうか・・。
12
+
13
+
14
+
9
15
  表についてもご提示いただけるとよいかと思います

1

こちらかがいいかも

2020/08/04 06:17

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -3,3 +3,7 @@
3
3
 
4
4
 
5
5
  Call filterData(ws, val)の部分を開示してくださるとよいかと思います。
6
+
7
+
8
+
9
+ 表についてもご提示いただけるとよいかと思います