Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Использование массива со справочником по нескольким условиям
 
#1
28.10.2020 09:20:41
Доброго времени суток.
Нужна помощь на форуме нашёл тему, но ввиду начинающего опыта в вба не могу до конца понять как написать макрос.
Задача стоит такая:
Во вложенном файле два листа, на листе "текущие" значения с которыми работаем, на листе "новые" значения, которые добавляются и могут содержать значения, которые уже есть на листе "текущие".
Чтобы не использовать формулу ИНДЕКС(ПОИСКПОЗ) так как значений очень много и процесс занимает долгое время, а использовать макрос vba с массивом и справочником.
Нужно на листе "новые" добавить ячейку и по 4 условиям отобразить какие уже есть на листе "текущие", чтобы взять только новые значения.
Код
Sub новые_решения()  
   Dim a(), b(), с(), d() , lLastrow As Long, i As Long  
   
   With Sheets("новые")  
       lLastrow = .Cells(Rows.Count, 10).End(xlUp).Row  
       a = Range(.[j2], .Range("C" & lLastrow)).Value
       ReDim aa(1 To UBound(a), 1 To 1)  
   End With  
 
   With Sheets("текущие")  
       lLastrow = .Cells(Rows.Count, 10).End(xlUp).Row  
       b = Range(.[j2], .Range("J" & lLastrow)).Value
       c = Range(.[t2], .Range("T" & lLastrow)).Value
   End With  
 
 
   
   With CreateObject("Scripting.Dictionary")  
       .CompareMode = 1  
 
       
       For i = 1 To UBound(a): .Item(Trim(a(i, 1))) = i: Next  
 
       
       For i = 1 To UBound(b)  
           If .exists(Trim(b(i, 1))) Then  
               aa(.Item(Trim(b(i, 1))), 1) = b(i, 1)  
           End If  
       Next  
 
   End With  
 
   
   Sheets("текущие").[I2].Resize(UBound(aa), 1) = aa
 
End Sub
 
 
 
#2
28.10.2020 09:25:01
мда..закроют чувствую)
Цитата
Дмитрий К написал:
Нужно на листе "новые" добавить ячейку и по 4 условиям
что за условия одному Вам известно) и логика тоже)
Изменено: Mershik - 28.10.2020 09:25:25
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
28.10.2020 10:54:03
Mershik, условия которые в примере прописаны, числовые по данным столбцам
 
 
 
#4
28.10.2020 12:40:45
Код
Sub Main()
    Dim aCurrent As Variant
    aCurrent = GetCurrent()
    
    Dim dic As Object
    Set dic = GetDicFromArray(aCurrent)
    
    Dim aNew As Variant
    aNew = GetNew()
    
    CompareCurrentAndNew dic, aNew
End Sub
'
Sub CompareCurrentAndNew(dic As Object, aNew As Variant)
    Dim r As Range
    Set r = Sheets("новые").Range("I1").Resize(UBound(aNew(0)))
    Dim a As Variant
    a = r
    Dim b As Variant
    ReDim b(0 To UBound(aNew))
    Dim y As Long
    Dim i As Long
    Dim s As String
    For y = 2 To UBound(aNew(0))
        For i = 0 To UBound(aNew)
            b(i) = aNew(i)(y, 1)
        Next
        s = Join(b, vbTab)
        If dic.Exists(s) Then
            a(y, 1) = "есть"
        Else
            a(y, 1) = 0
        End If
    Next
    
    r = a
End Sub
'
Function GetDicFromArray(a As Variant) As Object
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    Dim y As Long
    Dim i As Long
    Dim b As Variant
    ReDim b(0 To UBound(a))
    For y = 2 To UBound(a(0))
        For i = 0 To UBound(a)
            b(i) = a(i)(y, 1)
        Next
        dic.Item(Join(b, vbTab)) = y
    Next
     
    Set GetDicFromArray = dic
End Function
'
Function GetNew() As Variant
    Dim a As Variant
    Dim b As Variant
    a = Array("E", "J", "T", "W")
    ReDim b(0 To UBound(a))
    
    With Sheets("новые")
        Dim y As Long
        Dim i As Long
        y = .Cells(.Rows.Count, .Range(a(0) & "1").Column).End(xlUp).Row
        Dim v As Variant
        For Each v In a
            b(i) = .Range(a(i) & "1").Resize(y)
            i = i + 1
        Next
        
    End With


    GetNew = b
End Function
'
Function GetCurrent() As Variant
    Dim a As Variant
    Dim b As Variant
    a = Array("F", "J", "T", "W")
    ReDim b(0 To UBound(a))
    
    With Sheets("текущие")
        Dim y As Long
        Dim i As Long
        y = .Cells(.Rows.Count, .Range(a(0) & "1").Column).End(xlUp).Row
        Dim v As Variant
        For Each v In a
            b(i) = .Range(a(i) & "1").Resize(y)
            i = i + 1
        Next
        
    End With

    GetCurrent = b
End Function
 
 
 
#5
28.10.2020 12:49:31
МатросНаЗебре,спасибо за помощь  
 
 
 
Страницы: 1
Наверх