Question

我有一张包含三个字段（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

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

1 个答案: