質問編集履歴

1

実際に使用したマクロの追記(ほぼほぼサイトからの引用です)

2021/10/21 07:28

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -86,6 +86,162 @@
86
86
 
87
87
 
88
88
 
89
-
89
+ 追記:使用したマクロがあった方が良いとアドバイスをいただきましたので、下記に示します。
90
-
90
+
91
+
92
+
91
- Office365を利用るのExcel最新かと思ます
93
+ ①シート名が違いますが、別データで試たため気にしないでください。
94
+
95
+ こちらは単純に前月と当月で片方に居ない人を抽出するマクロとして改変して作りました。
96
+
97
+ (ttps://excel.kuuneruch.com/sabun-extra/)
98
+
99
+
100
+
101
+ Public Sub MainProc()
102
+
103
+ Dim shtMain As Worksheet
104
+
105
+ Dim motoName As String
106
+
107
+ Dim sakiName As String
108
+
109
+ Dim shtMoto As Worksheet
110
+
111
+ Dim shtSaki As Worksheet
112
+
113
+ Dim shtSabun As Worksheet
114
+
115
+ Dim lastRowMoto As Long
116
+
117
+ Dim lastRowSaki As Long
118
+
119
+ Dim lastCol As Long
120
+
121
+ Dim i As Long
122
+
123
+ Dim j As Long
124
+
125
+ Dim k As Long
126
+
127
+ Dim blnSame As Boolean
128
+
129
+ Dim blnExist As Boolean
130
+
131
+ Dim nowRow As Long
132
+
133
+
134
+
135
+ Set shtMain = ThisWorkbook.Sheets("メイン")
136
+
137
+ motoName = shtMain.Range("A2")
138
+
139
+ sakiName = shtMain.Range("B2")
140
+
141
+ Set shtMoto = ThisWorkbook.Sheets(motoName)
142
+
143
+ Set shtSaki = ThisWorkbook.Sheets(sakiName)
144
+
145
+ Set shtSabun = ThisWorkbook.Sheets("比較")
146
+
147
+ lastRowMoto = shtMoto.Cells(shtMoto.Rows.Count, 1).End(xlUp).Row
148
+
149
+ lastCol = shtMoto.Cells(1, shtMoto.Columns.Count).End(xlToLeft).Column
150
+
151
+ lastRowSaki = shtSaki.Cells(shtSaki.Rows.Count, 1).End(xlUp).Row
152
+
153
+ shtSabun.Cells.Clear
154
+
155
+ shtMoto.Range(shtMoto.Cells(1, 1), shtMoto.Cells(1, lastCol)).Copy (shtSabun.Cells(1, 1))
156
+
157
+ nowRow = 1
158
+
159
+ For i = 2 To lastRowMoto
160
+
161
+ blnExist = False
162
+
163
+ For j = 2 To lastRowSaki
164
+
165
+ blnSame = True
166
+
167
+ For k = 1 To lastCol
168
+
169
+ If shtMoto.Cells(i, k) <> shtSaki.Cells(j, k) Then
170
+
171
+ blnSame = False
172
+
173
+ Exit For
174
+
175
+ End If
176
+
177
+ Next
178
+
179
+ If blnSame = True Then
180
+
181
+ blnExist = True
182
+
183
+ Exit For
184
+
185
+ End If
186
+
187
+ Next
188
+
189
+ If blnExist = False Then
190
+
191
+ nowRow = nowRow + 1
192
+
193
+ shtMoto.Range(shtMoto.Cells(i, 1), shtMoto.Cells(i, lastCol)).Copy (shtSabun.Cells(nowRow, 1))
194
+
195
+ End If
196
+
197
+ Next
198
+
199
+ MsgBox "完了"
200
+
201
+ End Sub
202
+
203
+
204
+
205
+ ②こちらは参考にして作ったのですが、うまく出来ずに丸ごと消してしまったためもともと参考にしていたサイトの物を載せます。
206
+
207
+ (ttp://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/prog/prog04.html)
208
+
209
+
210
+
211
+ Sub prog4_1()
212
+
213
+   Dim myFld As String, myCri As String
214
+
215
+   Dim myRow As Long
216
+
217
+     myFld = InputBox("検索は何列目ですか?")
218
+
219
+     myCri = InputBox("検索する語句を入力しなさい")
220
+
221
+     'オートフィルタでデータを抽出する
222
+
223
+     Worksheets("データ").Range("A1").AutoFilter Field:=myFld, Criteria1:=myCri
224
+
225
+     ’抽出データの最終行を求める
226
+
227
+     myRow = Worksheets("データ").Range("A" & Rows.Count).End(xlUp).Row
228
+
229
+     '抽出先をクリアする
230
+
231
+     Worksheets("抽出").Range("A:E").ClearContents
232
+
233
+     '抽出データをコピーして貼り付け
234
+
235
+     Worksheets("データ").Range("A1:E" & myRow).Copy Worksheets("抽出").Range("A1")
236
+
237
+     'オートフィルタを解除
238
+
239
+     Worksheets("データ").Range("A1").AutoFilter
240
+
241
+     '抽出先シートをアクティブにしてA1セルを選択する
242
+
243
+     Worksheets("抽出").Activate
244
+
245
+     Range("A1").Select
246
+
247
+ End Sub