Excel VBA質問箱 IV

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

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


50042 / 76732 ←次へ | 前へ→

【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
1 hits

【31567】データマッチングについて マッチ 05/11/25(金) 17:00 質問
【31571】Re:データマッチングについて ichinose 05/11/25(金) 18:08 発言
【31575】Re:データマッチングについて だるま 05/11/25(金) 18:58 発言
【31586】Re:データマッチングについて Kein 05/11/25(金) 21:07 回答
【31590】Re:データマッチングについて Hirofumi 05/11/25(金) 22:55 回答

50042 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free