VBA Excel宏-显示与列相关的单元格值

Question

我需要从 P 列中获取唯一值，并将其显示在 Q 列中（到目前为止，我知道该怎么做）：

s1.Range("P2:P").RemoveDuplicates Columns:=1, Header:=x3No

但是我不知道如何将这些ID的值（ O 列）显示在 R 列中。重复的ID具有相同的值。每个唯一的ID只有一个值。有人可以帮我吗？

谢谢！

Answer 1

也许是这样：

Sub test()

Dim s1 As Worksheet
Set s1 = Worksheets("Sheet1")

Dim lrow As Long
Dim i As Long

s1.Range("O2:R100").RemoveDuplicates Columns:=2, Header:=xlYes 'remove duplicates from column 2 in range O2:R100

lrow = s1.Cells(Rows.Count, 16).End(xlUp).Row 'Find last row.

For i = 2 To lrow
    Cells(i, 18).Value = Cells(i, 16).Value 'Copy values
Next i
End Sub

---

我不会从O和P列中删除先前的值，而是将唯一ID和值列填充为唯一值。

Sub test()

Dim unique()
Dim ct As Long
Dim s1 As Worksheet
Dim lrow As Long
Dim x As Long
Dim y As Long

Set s1 = Worksheets("Sheet1")

ReDim unique(s1.Cells(s1.Rows.Count, 16).End(xlUp).Row)

lrow = s1.Cells(Rows.Count, 17).End(xlUp).Row + 1 'Find first row to fill with unique values


For x = 2 To s1.Cells(s1.Rows.Count, 16).End(xlUp).Row 'Column to check for unique values
    If CountIfArray(ActiveSheet.Cells(x, 16), unique()) = 0 Then 'Build array to store unique values.
        unique(ct) = ActiveSheet.Cells(x, 16).Text 'Populate the array
        Cells(lrow, 17).Value = Cells(x, 16).Value 'Copy column P to Q
        Cells(lrow, 18).Value = Cells(x, 15).Value  'Copy column O to R
        lrow = lrow + 1
        ct = ct + 1 
    End If
Next x
End Sub

Public Function CountIfArray(lookup_val As String, lookup_arr As Variant)
CountIfArray = Application.Count(Application.Match(lookup_val, lookup_arr, 0))
End Function