1

最近、Stack Overflow で非常に優れたスクリプトを見つけました。それは見事に機能しますが、少し調整したいと思います - 私のスキルではまだこの種の VBA で遊ぶことはできません. 今まで、私はこのコードの作り直しに失敗しただけです。

私の目標は、このスクリプトにその機能を実行させることですが、固定された場所から実行することです。そのため、「質問ボックス」で選択するのではなく、データ範囲をコピーしたくありません。例: 次A1:A200のように別のタブに貼り付けます。DATA!A1:A200

私たちを手伝ってくれますか？

そしてコード：

Sub ListUniqueValues()

 'lists the unique values found in a user-defined range into a
 'user-defined columnar range

 Dim SearchRng     As Range
 Dim ResultRng     As Range
 Dim Cel          As Range
 Dim iRow          As Long

 Set SearchRng = Application.InputBox("Select search range", _
       "Find Unique Values", Type:=8)
 Do
    Set ResultRng = Application.InputBox("Select results columnar range", _
       "Write Unique Values", Type:=8)
 Loop Until ResultRng.Columns.Count = 1

 iRow = 0
 For Each Cel In SearchRng
    If Application.WorksheetFunction.CountIf(ResultRng, Cel.Value) = 0 Then
       'This value doesn't already exist
       iRow = iRow + 1
       If iRow > ResultRng.Rows.Count Then
         MsgBox "Not enough rows in result range to write all unique values", _
         vbwarning, "Run terminated"
         Exit Sub
       Else
         ResultRng(iRow).Value = Cel.Value
       End If
    End If
 Next Cel

 'sort result range
 'ResultRng.Sort ResultRng

End Sub
4

1 に答える 1

1

あなたのDATA!A1:A200例の変更について

Set SearchRng = Application.InputBox("Select search range", _
   "Find Unique Values", Type:=8)

に

Set SearchRange = Sheets("DATA").Range("A1:A200")

編集

そうは言っても、この機能を見たことがありますか

Dim SearchRng As Range, ResultRng As Range
Set SearchRng = Sheets("DATA").Range("A1:A200")
Set ResultRng = Sheets("Results").Range("A2")
SearchRng.AdvancedFilter Action:= xlFilterCopy, CopyToRange:=ResultRng, Unique:=True
于 2012-11-05T15:26:40.753 に答える