Excel VBA質問箱 IV

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

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


29936 / 76733 ←次へ | 前へ→

【52070】Re:1行・1列のデータ重複について
回答  りん E-MAIL  - 07/10/18(木) 18:03 -

引用なし
パスワード
   カスミ さん、こんばんわ。

>エクセルのSheet1のとある行(1行目)のいくつかのセルの中にデータが入っているとして、そのデータの中に重複するものがあればそのセルの位置と内容をそれぞれSheet2のセル1Aにそれぞれ内容を出力し、重複が複数ある場合はその出力が改行して下に続いていくという判定を行いたいのですが・・・

>同様に列(1列目)もその列に含まれているデータの中で重複を調べ、重複があればセル5A(複数重複なら改行)に出力する方法を教えていただけないでしょうか。

こういう意味ですかね。

Sub test()
  Dim r1 As Range, r2 As Range, r3 As Range, NN As Long, II As Integer
  '
  For II = 1 To 2
   If II = 1 Then
     '1行目を処理
     With ThisWorkbook.Worksheets("Sheet1")
      Set r1 = Application.Intersect(.UsedRange, .Rows(1))
     End With
     Set r3 = ThisWorkbook.Worksheets("Sheet2").Cells(1, 1) '転記先
   Else
     '1列目を処理
     With ThisWorkbook.Worksheets("Sheet1")
      Set r1 = Application.Intersect(.UsedRange, .Columns(1))
     End With
     Set r3 = ThisWorkbook.Worksheets("Sheet2").Cells(5, 1) '転記先
   End If
   '
   NN = 0: br = ""
   For Each r2 In r1
     If Application.WorksheetFunction.CountIf(r1, r2.Value) > 1 Then
      '複数あったら転記する
      NN = NN + 1
      With r3
        '値:アドレス
        .Value = .Value & br & r2.Value & " : " & r2.Address(False, False)
      End With
      If NN = 1 Then br = vbCrLf
     End If
   Next
  Next
  '終了
  Set r1 = Nothing: Set r2 = Nothing: Set r3 = Nothing
End Sub

ところで、A1やA5を時々逆に書くのはなぜですか?

1 hits

【52051】1行・1列のデータ重複について カスミ 07/10/17(水) 22:22 質問
【52070】Re:1行・1列のデータ重複について りん 07/10/18(木) 18:03 回答
【52100】Re:1行・1列のデータ重複について カスミ 07/10/20(土) 22:02 お礼

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