Блог

Я хочу проверить, существует ли каждое конкретное значение (текст и числа) из диапазона 1 в диапазоне 2. Если нет, это значение должно быть добавлено к диапазону 2.

Для каждого цикла требуется слишком много времени. Я хочу попробовать с массивами:

1. создайте массив со всеми значениями из диапазона 1

2. создайте массив со всеми значениями из диапазона 2

3. проверьте, не является ли элемент массива 1 пустым
   3.1 если нет, проверьте, существует ли элемент в массиве 2
   3.1.1 если да, перейдите к следующему элементу массива 1
   3.1.2 если нет:
   3.1.2.1 добавить элемент в массив 2
   3.1.2.1 добавить элемент в диапазон 2 (в рабочей книге)
   3.2 если да,перейдите к следующему элементу массива 1

4. перейдите к следующему элементу массива 1 и повторите третий шаг

     Public Sub Table_And_Layout()
    Dim wsRoadmap As Worksheet
    Dim wsBacklog As Worksheet
    Dim bList As Range
    Dim Arr() As Variant
   
    Dim rListLastCol As Long
    Dim TempRng As Variant
    Dim element As Variant 'Range
   
    Set wsBacklog = Sheets("Backlog")
    Set wsRoadmap = Sheets("Roadmap")
   
    Set bList = wsBacklog.Range("C7", wsBacklog.Cells(bListLast, 3))
    bListLast = wsBacklog.Cells(wsBacklog.Rows.Count, "C").End(xlUp).Row
   
    Arr = wsRoadmap.Range("C6", wsRoadmap.Cells(rListLastRow, rListLastCol))
   
    For Each element In Arr
        If Not IsEmpty(element) Then
            Set TempRng = bList.Find(element.Value)
            If TempRng Is Nothing Then
                wsBacklog.Cells(bListLast   1, 3).Value = wsRoadmap.Cells(element.Row, element.Column).Value
                bListLast = wsBacklog.Cells(wsBacklog.Rows.Count, "C").End(xlUp).Row
            End If
        End If
    Next element
    End Sub
     

ВАРИАНТ 2 является самым быстрым:

 Public Sub Table_And_Layout()
    Dim wsRoadmap As Worksheet
    Dim wsBacklog As Worksheet
    
    Dim bList As Range
    Dim bListLast As Long
    Dim rList As Range
    Dim rListLastCol As Long
    
    Dim TempRng As Variant
    Dim element As Variant
    
'****************************
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
'****************************

'Remember time when macro starts
  StartTime = Timer
    
    Set wsBacklog = Sheets("Backlog")
    Set wsRoadmap = Sheets("Roadmap")

    ' unlock sheet
    wsBacklog.Unprotect
        
    bListLast = wsBacklog.Cells(wsBacklog.Rows.Count, "C").End(xlUp).Row
    Set bList = wsBacklog.Range("C7", wsBacklog.Cells(bListLast, 3))
        
    Set rList = wsRoadmap.Range("C6:BB100")
    
    ' find last not empty column
    rListLastCol = wsRoadmap.Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByColumns, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Column
        'MsgBox "Last Col: " amp; rListLastCol
        
    ' find last not empty row
    rListLastRow = wsRoadmap.Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row
        'MsgBox "Last Row: " amp; rListLastRow
        
    Set rList = wsRoadmap.Range("C6", wsRoadmap.Cells(rListLastRow, rListLastCol))
         'MsgBox rList.Address

'OPTION 1 (works but very slow)
'    ' filling backlog
'    For Each element In rList
'        If Not element Is Nothing Then
'            Set TempRng = bList.Find(element.Value)
'            If TempRng Is Nothing Then
'                wsBacklog.Cells(bListLast   1, 3).Value = wsRoadmap.Cells(element.Row, element.Column).Value
'                bListLast = wsBacklog.Cells(wsBacklog.Rows.Count, "C").End(xlUp).Row
'            End If
'        End If
'    Next element

'OPTION 2 (works fast)
    ' declare array for roadmap
    Dim Arr() As Variant ' declare an unallocated array.
    Arr = wsRoadmap.Range("C6", wsRoadmap.Cells(rListLastRow, rListLastCol)) ' Arr is now an allocated array
        '        Dim NumRows As Long
        '        Dim NumCols As Long
        '        MsgBox NumRows = UBound(Arr, 1) - LBound(Arr, 1)   1
        '        MsgBox NumCols = UBound(Arr, 2) - LBound(Arr, 2)   1

    ' declare array for backlog
    Dim ArrB() As Variant
    ArrB = wsBacklog.Range("C6", wsBacklog.Cells(bListLast, 3))
    
    'filling backloga
    For Each element In Arr
        If Not IsEmpty(element) Then
            Set TempRng = bList.Find(element)
            If TempRng Is Nothing Then
                wsBacklog.Cells(bListLast   1, 3).Value = element
                bListLast = wsBacklog.Cells(wsBacklog.Rows.Count, "C").End(xlUp).Row
            End If
        End If
    Next element
    
'OPTION 3 (does not work)
'    For i = LBound(Arr) To UBound(Arr)
'        For j = LBound(ArrB) To UBound(ArrB)
'            If Not IsEmpty(i) Then
'                If Arr(i) = ArrB(j) Then
'                    wsBacklog.Cells(bListLast   1, 3).Value = Arr(i)
'                End If
'            End If
'        Next
'    Next
  

'*************************************************************************************
'Determine how many seconds code took to run
  SecondsElapsed = Round(Timer - StartTime, 2)

'Notify user in seconds
  MsgBox "This code ran successfully in " amp; SecondsElapsed amp; " seconds", vbInformation
'*************************************************************************************
        
End Sub
  

PS. Спасибо, SJR!