如何从Excel VBA的值范围返回唯一值

Question

我在excel中有一个包含三个字段（ID，价格，日期）的表。 它有四条记录如下：

ID Price  Date
1  $400   1/1/2010
2  $500   1/2/2010
3  $200   1/1/2010
4  $899   1/2/2010

我想获取日期的每个值并将其放在单元格A2 ， A3 ， A4 ....但是，我想只采用唯一的日期，并且不采用已存储在前一个单元格中的任何日期。 例如，日期1/1/2010应当存储在单元A2和1/2/2010应当存储在单元A3 。 当谈到1/1/2010的第三条记录时，它应该忽略它，因为之前已经找到了类似的日期，依此类推。 谢谢你的帮助！

Answer 1

这里有一些VBA代码，您可以使用它们遍历第一张工作表，并仅将第一个唯一行复制到第二张工作表。 您的问题仅询问要复制的值，但此代码会复制整行。 您可以轻松删除不必要的列或修改代码。

Option Explicit

Sub Main()
    Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim uniqueCol As String
    Set wsSource = Worksheets("Sheet1")
    Set wsDestination = Worksheets("Sheet2")
    uniqueCol = "C"
    CopyFirstUniqueValuesToOtherWorksheet _
        wsSource, _
        wsDestination, _
        uniqueCol
End Sub

Sub CopyFirstUniqueValuesToOtherWorksheet( _
    sourceSheet As Worksheet, _
    destinationSheet As Worksheet, _
    uniqueCol As String)

    Dim iRow As Long
    Dim iHeaderRow As Long
    Dim rngUnique As Range
    iHeaderRow = 1
    iRow = iHeaderRow + 1

    'Clear contents of destination sheet '
    ClearDestinationSheet sourceSheet, destinationSheet

    'Copy Header Row '
    CopyRow sourceSheet, destinationSheet, iHeaderRow

    'Loop through source sheet and copy unique values '
    Do While Not IsEmpty(sourceSheet.Range("A" & iRow).value)
        Set rngUnique = sourceSheet.Range(uniqueCol & iRow)
        If Not ValueExistsInColumn(destinationSheet, uniqueCol, _
          CStr(rngUnique.value)) Then
            CopyRow sourceSheet, destinationSheet, iRow
        End If
        iRow = iRow + 1
    Loop


End Sub

Sub CopyRow(sourceSheet As Worksheet, _
    destinationSheet As Worksheet, _
    sourceRow As Long)

    Dim iDestRow As Long
    sourceSheet.Select
    sourceSheet.Rows(sourceRow & ":" & sourceRow).Select
    Selection.Copy
    iDestRow = 1
    Do While Not IsEmpty(destinationSheet.Range("A" & iDestRow).value)
        iDestRow = iDestRow + 1
    Loop
    destinationSheet.Select
    destinationSheet.Rows(iDestRow & ":" & iDestRow).Select
    ActiveSheet.Paste
    sourceSheet.Select
End Sub

Sub ClearDestinationSheet(sourceSheet As Worksheet, _
    destinationSheet As Worksheet)

    destinationSheet.Select
    Cells.Select
    Selection.ClearContents
    sourceSheet.Select
End Sub

Function ValueExistsInColumn(sheet As Worksheet, _
    col As String, _
    value As String) As Boolean

    Dim rng As Range
    Dim i As Long
    i = 2

    Do While Not IsEmpty(sheet.Range(col & i).value)
        Set rng = sheet.Range(col & i)
        If CStr(rng.value) = value Then
            ValueExistsInColumn = True
            Exit Function
        End If
        i = i + 1
    Loop

    ValueExistsInColumn = False
End Function