Вопрос:
У меня есть два 2D-массива (позволяет называть их A и B), которые содержат серийные номера в элементе 0 и даты в элементе 1. Многие серийные номера в находятся в B (около 60%). Если есть совпадение, мне нужно проверить, соответствует ли соответствующая дата в массиве B меньше даты в массиве A, если это так, то установите дату в равным null.
В настоящее время я использую цикл в цикле:
For x = 0 To UBound(arrayA) For y = 0 To UBound(arrayB) If arrayB(y, 0) = arrayA(x, 0) Then ‘ the serial numbers match If arrayB(y, 1) < arrayA(x, 1) Then ‘ test the dates arrayA(x, 1) = Null End If Exit For End If Next y Next x
Это работает отлично, но медленное (около 30-40 секунд), поэтому я пытался разработать другие методы, некоторые из них довольно дурацкие, такие как
dateB = application.Vlookup(arrayB, arrayA(x), 1, false
который занимает в два раза больше времени, и вам нужно обрабатывать найденные ошибки.
Я попытался создать два одномерных массива (сериалы, даты) вместо 2D-массива B и использовать application.match, чтобы предоставить индекс для даты, но это снова занимает примерно в два раза больше времени. Наконец, я пробовал записывать данные на рабочий лист, получая даты через vlookup и сравнивая их, но это не быстрее и на самом деле я этого не хочу.
Любые мысли оценили.
Лучший ответ:
Вот некоторые рамки для сравнения дат, основанных на серийных номерах.
Sub dictCompare() Dim a As Long, arrA As Variant, arrB As Variant, dictB As Object Debug.Print Timer Set dictB = CreateObject(«scripting.Dictionary») dictB.comparemode = vbTextCompare With Worksheets(«sheet1») With Intersect(.UsedRange, .Range(«A:B»)) arrA = .Cells.Value2 End With End With With Worksheets(«sheet2») With Intersect(.UsedRange, .Range(«A:B»)) arrB = .Cells.Value2 End With For a = LBound(arrB, 1) + 1 To UBound(arrB, 1) ‘LBound(arrB, 1)+1 to skip the column header label dictB.Item(arrB(a, 1)) = arrB(a, 2) Next a End With For a = LBound(arrA, 1) + 1 To UBound(arrA, 1) ‘LBound(arrA, 1)+1 to skip the column header label If dictB.exists(arrA(a, 1)) Then If dictB.Item(arrA(a, 1)) > arrA(a, 2) Then _ arrA(a, 2) = vbNullString End If Next a With Worksheets(«sheet1») .Cells(1, 1).Resize(UBound(arrA, 1), UBound(arrA, 2)) = arrA End With Debug.Print Timer End Sub
При необходимости отрегулируйте рабочие листы и диапазоны. Хотя результаты по времени очень субъективны, это занимает ~ ¹/₃ секунду на 30K рядах случайных данных как в Sheet1, так и в Sheet2.
