如何使用此代码以获取更多的工作表范围(VBA)

Question

我一直在使用下面的代码从Sheet1.Range("C4:C")获得唯一排序值并粘贴到Sheet2.Range("C4")。

但现在我想使用相同的代码从Sheet3.Range("C4:C")获得唯一排序值并粘贴到Sheet2.Range("G4").

现在的问题是如何在代码中提到工作表引用，哪个工作表范围唯一排序值将被粘贴。

标准模块(例如Module1)

Option Explicit
Sub copySortedUniqueColumn( _
SourceRange As Range, _
DestinationCell As Range, _
Optional ByVal doSort As Boolean = True)

Dim Data As Variant
If SourceRange.Rows.Count > 1 Or SourceRange.Columns.Count > 1 Then
Data = SourceRange.Value
Else
ReDim Data(1 To 1, 1 To 1): Data(1, 1) = SourceRange.Value
End If

Dim arl As Object: Set arl = CreateObject("System.Collections.ArrayList")
Dim Key As Variant
Dim i As Long
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For i = 1 To UBound(Data, 1)
Key = Data(i, 1)
If Not IsError(Key) Then
If Len(Key) > 0 Then
If Not .Exists(Key) Then
.Item(Key) = Empty
arl.Add Key
End If
End If
End If
Next i
If .Count = 0 Then Exit Sub
End With

If doSort Then
arl.Sort
End If

ReDim Data(1 To arl.Count, 1 To 1)
i = 0
For Each Key In arl
i = i + 1
Data(i, 1) = Key
Next Key

With DestinationCell
.Resize(.Worksheet.Rows.Count - .Row + 1).ClearContents
.Resize(i).Value = Data
End With
End Sub
Function defineColumnRange( _
FirstCellRange As Range) _
As Range
On Error GoTo clearError
If FirstCellRange Is Nothing Then GoTo ProcExit
With FirstCellRange
Dim cel As Range: Set cel = .Resize(.Worksheet.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If cel Is Nothing Then GoTo ProcExit
Set defineColumnRange = .Resize(cel.Row - .Row + 1)
End With
ProcExit:
Exit Function
clearError:
Resume ProcExit
End Function

Sheet Module (Sheet1)

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Const srcFirst As String = "C4"
Const dstFirst As String = "C4"

Dim srg As Range: Set srg = defineColumnRange(Range(srcFirst))
If srg Is Nothing Then
With Sheet2.Range(dstFirst)
.Resize(.Worksheet.Rows.Count - .Row + 1).ClearContents
End With
Exit Sub
End If

Dim rg As Range: Set rg = Intersect(srg, Target)
If rg Is Nothing Then Exit Sub

Dim dCel As Range: Set dCel = Sheet2.Range(dstFirst)

On Error GoTo clearError

Application.EnableEvents = False
copySortedUniqueColumn srg, dCel
SafeExit:
Application.EnableEvents = True
Exit Sub
clearError:
Resume SafeExit
End Sub

Answer 1

只需做以下操作:

将工作表模块代码(最初放在Sheet1中)复制到Sheet3的工作表模块，并将dstFirst更改为G4。

(这是我对过滤唯一值并将a排序到Z Excel VBA的回答的后续问题)