| |
結果を表示するシートは、必ず「ブックの左端にあり」「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シートを開き、ダブルクリック
した列までスクロールして終了します。
|
|
Kein
- 06/10/19(木) 14:05 -
