Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

50048 / 76738

←次へ　｜　前へ→


	【31586】Re:データマッチングについて

Kein - 05/11/25(金) 21:07 -


	引用なし

	パスワード

こんな感じでどうかな ?
データのあるシートを開いて実行します。アクティブシートの次のシートのA,B列に
抽出した重複値を表示します。

Sub MyMatch()
　 Dim LR1 As Long, LR2 As Long
　 Dim Nm As String
　 Dim x As Variant, y As Variant
　
　 Application.ScreenUpdating = False
　 With ActiveSheet
　　　If .Index = Worksheets.Count Then Exit Sub
　　　Nm = .Name & "!"
　　　LR1 = .Range("A65536").End(xlUp).Row
　　　LR2 = .Range("B65536").End(xlUp).Row
　　　With .Next
　　　　 .Cells.ClearContents
　　　　 .Range("A1:A" & LR1).Formula = _
　　　　 "=IF(ISERR(MATCH(" & Nm & "$A1," & Nm & "$B:$B,0)),""Z"",ROW()&"".""&$A1)"
　　　　 .Range("C1:C" & LR2).Formula = _
　　　　 "=IF(ISERR(MATCH(" & Nm & "$B1," & Nm & "$A:$A,0)),""Z"",ROW()&"",""&$B1)"
　　　　 .Range("A:C").Copy
　　　　 .Range("A1").PasteSpecial xlPasteValues
　　　　 .Range("A1:A" & LR1).Sort Key1:=.Columns(1), _
　　　　 Order1:=xlAscending, Header:=xlNo, Orientation:=xlSortColumns
　　　　 .Range("C1:C" & LR2).Sort Key1:=.Columns(3), _
　　　　 Order1:=xlAscending, Header:=xlNo, Orientation:=xlSortColumns
　　　　 x = Application.Match("Z", .Range("A:A"), 0)
　　　　 If Not IsError(x) Then
　　　　　　.Range("A" & x & ":A65536").ClearContents
　　　　 End If
　　　　 y = Application.Match("Z", .Range("C:C"), 0)
　　　　 If Not IsError(y) Then
　　　　　　.Range("C" & y & ":C65536").ClearContents
　　　　 End If
　　　　 .Range("A1:A" & LR1).TextToColumns DataType:=xlDelimited, _
　　　　 Comma:=True
　　　　 .Range("C1:C" & LR2).TextToColumns DataType:=xlDelimited, _
　　　　 Comma:=True
　　　　 .Columns(3).Delete xlShiftToLeft
　　　　 .Columns(1).Delete xlShiftToLeft
　　　　 .Activate
　　　End With
　 End With
　 With Application
　　　.CutCopyMode = False
　　　.ScreenUpdating = True
　 End With
End Sub

0 hits

▼

【31567】データマッチングについて マッチ 05/11/25(金) 17:00