質問編集履歴

3

ソースの余計なコードを削除しました

2019/07/09 08:01

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -180,7 +180,7 @@
180
180
 
181
181
  Selection.AutoFilter
182
182
 
183
- ActiveSheet.Range("$A$1:$E$7").AutoFilter Field:=1, Criteria1:=Array( _
183
+ ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:=Array( _
184
184
 
185
185
  "パイナップル", "みかん", "リンゴ"), Operator:=xlFilterValues
186
186
 
@@ -220,15 +220,7 @@
220
220
 
221
221
  MsgBox (rr)
222
222
 
223
-
224
-
225
-
226
-
227
- 'メッセージボックスにセル値出力
223
+
228
-
229
- strcolor = Range("C" & p).Interior.Color
230
-
231
-
232
224
 
233
225
 
234
226
 

2

サンプルコードの説明を追加し、Excelのデータも貼り直しました。

2019/07/09 08:01

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -20,254 +20,254 @@
20
20
 
21
21
  現在、Excelではこのようなデータを作っています。
22
22
 
23
+ ![イメージ説明](468cf4609abd46aca27f63028dff24d2.png)
24
+
25
+
26
+
27
+ ここから、Aの果物で「パイナップル」「リンゴ」「みかん」をキーにフィルターをかけます。
28
+
29
+ するとこう表示されます。
30
+
31
+
32
+
33
+ ![イメージ説明](aa49a7a00277b0a790bcb05f86f5b1ac.png)
34
+
35
+
36
+
37
+ その後、フィルターした結果のC列から担当者名をメッセージボックスで表示させたいです。
38
+
39
+ つまり、この場合は動かすと、
40
+
41
+
42
+
43
+ ループ1回目 → 「山田」
44
+
45
+ ループ2回目 → 「直原」
46
+
47
+ ループ3回目 → 「浅井」
48
+
49
+ ループ4回目 → 「弥中」
50
+
51
+
52
+
53
+ が表示されることになります。
54
+
55
+
56
+
57
+ しかし、現状のプログラムだと、
58
+
59
+
60
+
61
+ ループ1回目 → 「担当者」
62
+
63
+ ループ2回目 → 「山田」
64
+
65
+ ループ3回目 → 「直原」
66
+
67
+ ループ4回目 → 「浅井」
68
+
69
+ ループ5回目 → 「弥中」
70
+
71
+
72
+
73
+ と表示されてしまいます。
74
+
75
+
76
+
77
+ これを、1回目は「担当者」ではなく「山下」が表示されるようにしたいです。
78
+
79
+
80
+
81
+
82
+
83
+ ### 該当のソースコード
84
+
85
+
86
+
87
+ ```ExcelVBA
88
+
89
+
90
+
91
+
92
+
93
+ Option Explicit
94
+
95
+
96
+
97
+ Private Sub cmd_start_Click()
98
+
99
+
100
+
101
+ Dim wbinput As Workbook 'インプットファイル格納
102
+
103
+ Dim wbinput_Sheet As Worksheet 'インプットファイルのシート
104
+
105
+ Dim wboutput As Workbook 'アウトプットファイル格納
106
+
107
+ Dim wboutput_Sheet As Worksheet 'アウトプットファイルのシート
108
+
109
+
110
+
111
+ Dim stroutput_FName As String
112
+
113
+ Dim strSheetName As String
114
+
115
+ Dim endcol As Long 'エンド列名
116
+
117
+
118
+
119
+ Dim strcolor As String
120
+
121
+
122
+
123
+ Dim p As Long, n As Long 'カウンタ変数
124
+
125
+ Dim r As Range, rr As Range, rs As Range 'Visibleセルを取得する変数
126
+
127
+
128
+
129
+
130
+
131
+ '+++++++++定義+++++++
132
+
133
+
134
+
135
+ p = 0
136
+
137
+ n = 2
138
+
139
+ strSheetName = "sheet1"
140
+
141
+
142
+
143
+ '+++++++++++++++++++
144
+
145
+
146
+
147
+ 'アウトプットファイルのファイル名取得
148
+
149
+ stroutput_FName = ActiveWorkbook.Name
150
+
151
+
152
+
153
+ 'アウトプットファイルのファイルパスを取得
154
+
155
+ Workbooks.Open ThisWorkbook.Path & "\" & stroutput_FName
156
+
157
+ Set wboutput = ActiveWorkbook 'アクティブなワークブック
158
+
159
+
160
+
161
+
162
+
163
+ 'ほしいデータのあるシートをアクティブにする
164
+
165
+ Set wboutput_Sheet = wboutput.Worksheets(strSheetName)
166
+
167
+ wboutput_Sheet.Activate
168
+
169
+
170
+
171
+
172
+
173
+ With wboutput
174
+
175
+
176
+
177
+ 'オートフィルタをセット
178
+
179
+ Rows("1:1").Select
180
+
181
+ Selection.AutoFilter
182
+
183
+ ActiveSheet.Range("$A$1:$E$7").AutoFilter Field:=1, Criteria1:=Array( _
184
+
185
+ "パイナップル", "みかん", "リンゴ"), Operator:=xlFilterValues
186
+
187
+
188
+
189
+
190
+
191
+ 'オートフィルタの結果から担当者の名前をメッセージボックスで表示
192
+
193
+ Set r = Range("C1", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
194
+
195
+
196
+
197
+
198
+
199
+ 'r:A1~データの存在する最大行セルまでの範囲(表示されているセルのみ)
200
+
201
+ 'rr:A1~データの存在する最大行セルまで、A1から1つずつ格納される
202
+
203
+ For Each rr In r
204
+
205
+
206
+
207
+ 'rsへ選択セルの値を格納
208
+
209
+ For Each rs In rr.Areas
210
+
211
+
212
+
213
+ '選択セルの行数を取得
214
+
215
+ p = (rs.Row)
216
+
217
+
218
+
219
+ 'メッセージボックスに担当者名出力
220
+
221
+ MsgBox (rr)
222
+
223
+
224
+
225
+
226
+
227
+ 'メッセージボックスにセル値出力
228
+
229
+ strcolor = Range("C" & p).Interior.Color
230
+
231
+
232
+
233
+
234
+
235
+ n = n + 1
236
+
237
+
238
+
239
+ Next
240
+
241
+
242
+
243
+ Next
244
+
245
+
246
+
247
+ Application.DisplayAlerts = False
248
+
249
+
250
+
251
+ .Close
252
+
253
+
254
+
255
+ Application.DisplayAlerts = True
256
+
257
+
258
+
259
+ End With
260
+
261
+
262
+
263
+ End Sub
264
+
265
+
266
+
267
+
268
+
23
269
  ```
24
270
 
25
- | A | B | C | D   | E |
26
-
27
- 1| 果物 |価格|担当者| 店舗 | 住所|
28
-
29
- 2|みかん|400 | 山中 |あおい野菜|東京都|
30
-
31
- 3|りんご|350 |森下 |宮下野菜店|山形県|
32
-
33
- 4|みかん|400 |山中 |わいわい |静岡県|
34
-
35
- 5|キウイ|500 |真下 |あおい野菜|東京都|
36
-
37
- 6|りんご|400 |直川 |轟ファーム|岡山県|
38
-
39
- ```
40
-
41
-
42
-
43
- ここから、Dの店舗で「あおい野菜」をキーにフィルターをかけます。
44
-
45
- するとこう表示されます。
46
-
47
-
48
-
49
- ```
50
-
51
- | A | B | C | D   | E |
52
-
53
- 1| 果物 |価格|担当者| 店舗 | 住所|
54
-
55
- 2|みかん|400 | 山中 |あおい野菜|東京都|
56
-
57
- 5|キウイ|500 |真下 |あおい野菜|東京都|
58
-
59
- ```
60
-
61
-
62
-
63
- その後、フィルターした結果のC列から担当者名をメッセージボックスで表示させたいです。
64
-
65
- つまり、この場合は動かすと、
66
-
67
-
68
-
69
- ループ1回目 → 「山中」
70
-
71
- ループ2回目 → 「真下」
72
-
73
-
74
-
75
- が表示されることになります。
76
-
77
-
78
-
79
- しかし、現状のプログラムだと、
80
-
81
-
82
-
83
- ループ1回目 → 「担当者」
84
-
85
- ループ2回目 → 「山中」
86
-
87
- ループ3回目 → 「真下」
88
-
89
-
90
-
91
- と表示されてしまいます。
92
-
93
-
94
-
95
- これを、1回目は「担当者」ではなく「山下」が表示されるようにしたいです。
96
-
97
-
98
-
99
-
100
-
101
- ### 該当のソースコード
102
-
103
-
104
-
105
- ```ExcelVBA
106
-
107
-
108
-
109
-
110
-
111
- Option Explicit
112
-
113
-
114
-
115
- Private Sub cmd_start_Click()
116
-
117
-
118
-
119
- Dim wbinput As Workbook 'インプットファイル格納
120
-
121
- Dim wbinput_Sheet As Worksheet 'インプットファイルのシート
122
-
123
- Dim wboutput As Workbook 'アウトプットファイル格納
124
-
125
- Dim wboutput_Sheet As Worksheet 'アウトプットファイルのシート
126
-
127
-
128
-
129
- Dim stroutput_FName As String
130
-
131
- Dim strSheetName As String
132
-
133
- Dim endcol As Long 'エンド列名
134
-
135
-
136
-
137
- Dim strcolor As String
138
-
139
-
140
-
141
- Dim p As Long, n As Long 'カウンタ変数
142
-
143
- Dim r As Range, rr As Range, rs As Range 'Visibleセルを取得する変数
144
-
145
-
146
-
147
-
148
-
149
- '+++++++++定義+++++++
150
-
151
-
152
-
153
- p = 0
154
-
155
- n = 2
156
-
157
- strSheetName = "sheet1"
158
-
159
-
160
-
161
- '+++++++++++++++++++
162
-
163
-
164
-
165
- 'アウトプットファイルのファイル名取得
166
-
167
- stroutput_FName = ActiveWorkbook.Name
168
-
169
-
170
-
171
- 'アウトプットファイルのファイルパスを取得
172
-
173
- Workbooks.Open ThisWorkbook.Path & "\" & stroutput_FName
174
-
175
- Set wboutput = ActiveWorkbook 'アクティブなワークブック
176
-
177
-
178
-
179
-
180
-
181
- 'ほしいデータのあるシートをアクティブにする
182
-
183
- Set wboutput_Sheet = wboutput.Worksheets(strSheetName)
184
-
185
- wboutput_Sheet.Activate
186
-
187
-
188
-
189
-
190
-
191
- With wboutput
192
-
193
-
194
-
195
- 'オートフィルタをセット
196
-
197
- Rows("1:1").Select
198
-
199
- Selection.AutoFilter
200
-
201
- ActiveSheet.Range("$A$1:$E$7").AutoFilter Field:=1, Criteria1:=Array( _
202
-
203
- "みかん", "リンゴ"), Operator:=xlFilterValues
204
-
205
-
206
-
207
-
208
-
209
- 'オートフィルタの結果から担当者の名前をメッセージボックスで表示
210
-
211
- Set r = Range("C1", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
212
-
213
-
214
-
215
- For Each rr In r
216
-
217
-
218
-
219
- 'rsへ選択セルの値を格納
220
-
221
- For Each rs In rr.Areas
222
-
223
-
224
-
225
- '選択セルの行数を取得
226
-
227
- p = (rs.Row)
228
-
229
-
230
-
231
- 'メッセージボックスに担当者名出力
232
-
233
- MsgBox (rr)
234
-
235
-
236
-
237
- n = n + 1
238
-
239
-
240
-
241
- Next
242
-
243
-
244
-
245
- Next
246
-
247
-
248
-
249
- Application.DisplayAlerts = False
250
-
251
-
252
-
253
- .Close
254
-
255
-
256
-
257
- Application.DisplayAlerts = True
258
-
259
-
260
-
261
- End With
262
-
263
-
264
-
265
- End Sub
266
-
267
-
268
-
269
- ```
270
-
271
271
 
272
272
 
273
273
  ### 試したこと

1

説明文に間違いがあり修正しました

2019/07/09 07:59

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -54,13 +54,7 @@
54
54
 
55
55
  2|みかん|400 | 山中 |あおい野菜|東京都|
56
56
 
57
- 3|りんご|350 |下 |宮下野菜|山形県|
57
+ 5|キウイ|500 |下 |あおい野菜|東京都|
58
-
59
- 4|みかん|400 |山中 |わいわい |静岡県|
60
-
61
- 6|りんご|400 |直川 |轟ファーム|岡山県|
62
-
63
-
64
58
 
65
59
  ```
66
60
 
@@ -76,10 +70,6 @@
76
70
 
77
71
  ループ2回目 → 「真下」
78
72
 
79
- ループ3回目 → 「山中」
80
-
81
- ループ4回目 → 「直川」
82
-
83
73
 
84
74
 
85
75
  が表示されることになります。
@@ -96,10 +86,6 @@
96
86
 
97
87
  ループ3回目 → 「真下」
98
88
 
99
- ループ4回目 → 「山中」
100
-
101
- ループ5回目 → 「直川」
102
-
103
89
 
104
90
 
105
91
  と表示されてしまいます。