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

我在Excel中有一个包含三个字段（ID，Price，Date）的表。它有四个记录如下：如何从一个范围值中返回唯一值Excel VBA

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时，应该忽略它，因为之前已经找到类似的日期等等。感谢您的帮助！

来源

2010-08-28 guest1

下面是一些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

来源

2010-08-29 17:57:03

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

回答

相关问题