如何從一個範圍值中返回唯一值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

回答

相關問題