回答編集履歴

1

サンプルコードの追加

2019/02/06 07:59

投稿

hatena19
hatena19

スコア33722

test CHANGED
@@ -71,3 +71,85 @@
71
71
  End Sub
72
72
 
73
73
  ```
74
+
75
+
76
+
77
+ 追記
78
+
79
+ ---
80
+
81
+
82
+
83
+ コメントのコードは繰り返しが多いので、配列を使うとコンパクトに記述できます。
84
+
85
+ ```vba
86
+
87
+ Private Sub CommandButton1_Click()
88
+
89
+ Dim N As Long, i As Long
90
+
91
+ Dim Cr(1 To 3) As String
92
+
93
+
94
+
95
+ Application.ScreenUpdating = False
96
+
97
+
98
+
99
+ For i = 1 To 3
100
+
101
+ With Me("ListBox" & i)
102
+
103
+ For N = 0 To .ListCount - 1
104
+
105
+ If .Selected(N) Then
106
+
107
+ Cr(i) = Cr(i) & " " & .List(N)
108
+
109
+ End If
110
+
111
+ Next N
112
+
113
+ End With
114
+
115
+ Cr(i) = Trim(Cr(i))
116
+
117
+ If Cr(i) = "" Then
118
+
119
+ MsgBox "リスト" & i & "から選択してください。"
120
+
121
+ Exit Sub
122
+
123
+ End If
124
+
125
+ Next i
126
+
127
+ Worksheets("①抽出結果").Range("A1").CurrentRegion.ClearContents
128
+
129
+ With Worksheets("抽出元データ").Range("A1")
130
+
131
+ For i = 1 To 3
132
+
133
+ .AutoFilter Field:=i, _
134
+
135
+ Criteria1:=Split(Cr(i)), _
136
+
137
+ Operator:=xlFilterValues
138
+
139
+ Next i
140
+
141
+
142
+
143
+ .CurrentRegion.Copy Worksheets("①抽出結果").Range("A1")
144
+
145
+ .AutoFilter
146
+
147
+ End With
148
+
149
+
150
+
151
+ Application.ScreenUpdating = True
152
+
153
+ End Sub
154
+
155
+ ```