VBA запускает макрос несколько раз - PullRequest
0 голосов
/ 13 июля 2020

Недавно я создал макрос для извлечения всех уникальных значений из диапазона и добавления их на другой лист. Мне нужно иметь возможность запускать макрос каждый день, поскольку я веду записи, поэтому на следующий день я бы хотел, чтобы он 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))


Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...