Недавно я создал макрос для извлечения всех уникальных значений из диапазона и добавления их на другой лист. Мне нужно иметь возможность запускать макрос каждый день, поскольку я веду записи, поэтому на следующий день я бы хотел, чтобы он go переходил к следующей пустой строке и заполнял ее данными за этот день. Во время тестирования я решил, что если я запустил макрос во второй раз, данные будут просто заполнены под первым набором данных, однако это не код случая ниже.
Function UNIQUES(rng As Range) As Variant()
Dim list As New Collection
Dim Ulist() As Variant
'Adding each value of rng to the collection.
On Error Resume Next
For Each Value In rng
'here value and key are the same. The collection does not allow duplicate keys hence only unique values will remain.
list.Add CStr(Value), CStr(Value)
Next
On Error GoTo 0
'Defining the length of the array to the number of unique values. Since the array starts from 0, we subtract 1.
ReDim Ulist(list.Count - 1, 0)
'Adding unique value to the array.
For i = 0 To list.Count - 1
Ulist(i, 0) = list(i + 1)
Next
'Printing the array
UNIQUES = Ulist
End Function
Function CountUniqueValues(InputRange As Range) As Integer
Dim CellValue As Variant, UniqueValues As New Collection
Application.Volatile
On Error Resume Next
For Each CellValue In InputRange
UniqueValues.Add CellValue, CStr(CellValue)
Next
CountUniqueValues = UniqueValues.Count
End Function
Sub Testing()
Dim Wb As Workbook
Dim path As String
path = "/Users/benlong/Documents/tradingtest.xlsm"
Set Wb = Workbooks.Open(path)
Dim Ws As Worksheet
Set Ws = Wb.Worksheets("Sheet1")
Dim lt As Long
lt = Ws.Cells(Rows.Count, 3).End(xlUp).Row
Dim Lasttrade As Long
Lasttrade = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Dim mats As Long
mats = CountUniqueValues(Ws.Range("C2:C" & lt))
Range("C" & Lasttrade - 1, "C" & Lasttrade + mats - 2).Value = UNIQUES(Ws.Range("C2:C" & lt))