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

Question

我需要从列 中获取唯一值电话 并将它们显示在 列中问 (到目前为止我知道该怎么做):

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 和 value 列。

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