Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6700 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【43566】同一列内に同一データ検索 Help me!! 06/10/19(木) 11:51 質問[未読]
【43573】Re:同一列内に同一データ検索 壁 06/10/19(木) 12:53 発言[未読]
【43627】Re:同一列内に同一データ検索 Help me!! 06/10/20(金) 9:54 お礼[未読]
【43578】Re:同一列内に同一データ検索 Kein 06/10/19(木) 14:05 回答[未読]
【43579】Re:同一列内に同一データ検索 Kein 06/10/19(木) 14:09 発言[未読]
【43629】Re:同一列内に同一データ検索 Help me!! 06/10/20(金) 9:57 質問[未読]
【43635】Re:同一列内に同一データ検索 Kein 06/10/20(金) 15:25 発言[未読]
【43692】Re:同一列内に同一データ検索 Help me!! 06/10/23(月) 10:51 お礼[未読]
【43566】同一列内に同一データ検索
質問  Help me!!  - 06/10/19(木) 11:51 -
引用なし
パスワード
   いつもココで勉強させてもらっています。
今回もよろしくお願いします。

今回やりたいことは、エクセルの同一の列内に同一のデータが存在するかしないかを判定するマクロを作りたいです。
また、検索する列を実行時に選択出来るようにしたいです。（inputboxか何かでA,とかB、とか列名を指定したいです。）

言葉では表しにくいので表を書きます。

　　　A列　　　B列
１行　佐藤　　　２
２行　鈴木　　　３
３行　伊藤　　　２
４行　佐藤　　　１

とあった場合。
マクロ実行時にA列をしてしたら、別のシート（新規にシート作成）に「佐藤」と表示されれば最高です！
また別例で上記の表で検索をB列に指定したら別のシート（新規にシート作成）に「２」と表示されれば最高です！

どなたかご教授のほどよろしくお願いします。

　　　　　
【43573】Re:同一列内に同一データ検索
発言  壁  - 06/10/19(木) 12:53 -
引用なし
パスワード
   新規シートでなく、イミディエイトウィンドウに表示ですが･･･。
これは以前このページで見つけたものです。
私は初心者なので、そのままコピペで貼りつけました。
ご参考までに
↓


Sub Check_Uniq_Data()
　 Debug.Print "[ 重複のあるデータ ]"
　 On Error Resume Next
　 With Range("A1", Range("A65536").End(xlUp)).Offset(, 255)
　　　.Formula = _
　　　"=IF(AND(COUNTIF(A:A,A1)>1,MATCH(A1,A:A,0)=ROW()),A1,0)"　　　　　　　　　　　　'A列中の重複データを探す。
　　　For Each C In .SpecialCells(3, 2)
　　　　 Debug.Print C.Value
　　　Next
　　　.ClearContents
　 End With
　 On Error GoTo 0
　 SendKeys "^(g)", True
End Sub
【43578】Re:同一列内に同一データ検索
回答  Kein  - 06/10/19(木) 14:05 -
引用なし
パスワード
   結果を表示するシートは、必ず「ブックの左端にあり」「Resultという名前である」
ということにします。現在無ければ、ダブルクリック実行時に自動的に追加します。
>inputboxか何か
に値を入力して指定するのは煩わしいので「ダブルクリックしたセルの列」を
対象にします。従ってイベントマクロになりますから、シートモジュールに
入れて下さい。コードは・・

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
　 Dim Sh As Worksheet
　 Dim Col As Integer, Col2 As Integer
　　　
　 Col = Target.Column
　 If Col = 256 Then Exit Sub
　 Col2 = (256 - Col) * -1
　 If WorksheetFunction.CountA(Columns(Col)) < 2 Then Exit Sub
　 Range("IV:IV").ClearContents
　 Intersect(Columns(Col).SpecialCells(2).EntireRow, Range("IV:IV")) _
　 .FormulaR1C1 = "=IF(COUNTIF(R1C[" & Col2 & "]:RC[" & Col2 & _
　 "],RC[" & Col2 & "])=2,RC[" & Col2 & "],FALSE)"
　 Cancel = True: Set Sh = ActiveSheet
　 Range("IV:IV").SpecialCells(3, 4).ClearContents
　 On Error Resume Next
　 If Worksheets(1).Name <> "Result" Then
　　　Worksheets.Add(Before:=Worksheets(1)).Name = "Result"
　 End If
　 On Error GoTo 0
　 With Worksheets("Result")
　　　If .Index > 1 Then .Move Before:=Worksheets(1)
　　　.Columns(Col).ClearContents
　　　Sh.Range("IV:IV").SpecialCells(3).Copy
　　　.Cells(1, Col).PasteSpecial xlPasteValues
　　　Application.Goto .Cells(1, Col), True
　 End With
　 Sh.Range("IV:IV").ClearContents: Set Sh = Nothing
　 Application.CutCopyMode = False
End Sub

ただし、IV列(シートの最終列)のみは作業列とするので、
ダブルクリックは無効になります。もちろん、値が1つ以下しか
入力されていない列でダブルクリックした場合も、マクロは中止します。
正常に重複値をコピーできた場合、Resultシートを開き、ダブルクリック
した列までスクロールして終了します。
【43579】Re:同一列内に同一データ検索
発言  Kein  - 06/10/19(木) 14:09 -
引用なし
パスワード
   一つ修正があります。
>On Error GoTo 0
は、削除しておいて下さい。
【43627】Re:同一列内に同一データ検索
お礼  Help me!!  - 06/10/20(金) 9:54 -
引用なし
パスワード
   ▼壁 さん：

ありがとうございます！参考になりました！！
【43629】Re:同一列内に同一データ検索
質問  Help me!!  - 06/10/20(金) 9:57 -
引用なし
パスワード
   ▼Kein さん：
すごい！すごい！！すごすぎます！！
本当に感動しました。

でも一つだけ出来れば直して欲しい事があります。
ダブルクリックでマクロ開始はすごくありがたいのですが、出来れば一番上の行（項目行）だけ反応するようにできませんか？

わがままばかりで申し訳ございませんが、何卒ご教授のほどよろしくお願いします。
【43635】Re:同一列内に同一データ検索
発言  Kein  - 06/10/20(金) 15:25 -
引用なし
パスワード
   >一番上の行（項目行）だけ反応
コードの先頭に一行追加するだけです。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
　 Dim Sh As Worksheet
　 Dim Col As Integer, Col2 As Integer

　 If Target.Row > 1 Then Exit Sub '←これを追加　　　
　 Col = Target.Column
【43692】Re:同一列内に同一データ検索
お礼  Help me!!  - 06/10/23(月) 10:51 -
引用なし
パスワード
   ▼Kein さん：
本当に助かりました。
これで上司に怒られなくてすみます。
今まではずっと目で確認していたのですが、やはり目では限界があるみたいで見落としてました。
これがあれば簡単に事が進みます！
本当にありがとうございました！
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6700 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free