Question

最近我在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

Answer 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

从固定位置提取唯一数据

1 个答案: