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

【问题标题】：VBA Excel macro - display cell values which are column relatedVBA Excel 宏 - 显示与列相关的单元格值
【发布时间】：2018-10-29 13:26:19
【问题描述】：

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

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

但我不知道如何将这些 id 的值（列 O ）显示到列 R 中。重复的 id 具有相同的值。每个唯一的 id 只有一个值。谁能帮帮我？

谢谢！

【问题讨论】：

你为什么不使用O2:P10范围删除重复项？
@BigBen 感谢您的回复，我不知何故认为这应该更难，但简单总是赢：D

标签： excel vba

【解决方案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

【讨论】：