VBA Array help - без ошибок, но не возвращает правильные данные

Question

*** Изменить на вопрос ниже. Я играл с ним, и проблема в моем массиве resultArray (i). Когда вместо строки resultArray(i) = Sheets("DeSL_CP").Range("P" & j).Value я использую .Range("M" & i).Value = Sheets("DeSL_CP").Range("P" & j).Value, это работает, но занимает больше времени. Кто-нибудь может определить, почему мой массив результатов (i) возвращает все нули?

*** Исходное сообщение: Я новичок в массивах, поэтому я, вероятно, делаю глупую ошибку. У меня есть два листа: у Summary есть продукция в столбце A и поле, помечающее продукт как нелицензированный или лицензированный в AK. DeSL_CP имеет несколько строк для каждого идентификатора продукта (в столбце B). Мне нужно найти строку с кодом активности (Col K) AA0001 для нелицензионного продукта и вернуть дату окончания базовой линии (col P). Затем мне нужно найти код A0003 для оставшихся продуктов и вернуть конец строки. Базовый N должен быть в столбце M сводного листа

Мой код не выдает ошибки. Он просто заполняет весь столбец M 1/0/1900. Помогите!

Sheets("Summary").Select
Dim lastRow As Long, lastRow1 As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
lastRow1 = Sheets("DeSL_CP").Range("A" & Rows.Count).End(xlUp).Row
lastRow1 = lastRow1 - 1


Dim BaselineEnd As Variant, ActivityCode As Variant, ProductIDDeSL As Variant, Licensed As Variant, ProductIDSumm As Variant
BaselineEnd = ThisWorkbook.Worksheets("DeSL_CP").Range("P2:P" & lastRow1).Value
ActivityCode = ThisWorkbook.Worksheets("DeSL_CP").Range("K2:K" & lastRow1).Value
ProductIDDeSL = ThisWorkbook.Worksheets("DeSL_CP").Range("B2:B" & lastRow1).Value
Licensed = ThisWorkbook.Worksheets("Summary").Range("AK7:AK" & lastRow).Value
ProductIDSumm = ThisWorkbook.Worksheets("Summary").Range("A7:A" & lastRow).Value

Dim resultArray() As Date
ReDim resultArray(7 To lastRow)
Dim i As Long, j As Long

With ThisWorkbook.Worksheets("Summary")
For i = 7 To UBound(ProductIDSumm)
    For j = 2 To UBound(ProductIDDeSL)
    If ProductIDSumm(i, 1) = ProductIDDeSL(j, 1) Then
        If Licensed(i, 1) = "Unlicensed" Then
            If ActivityCode(j, 1) = "AA0001" Then
                    resultArray(i) = Sheets("DeSL_CP").Range("P" & j).Value
                    Exit For
            End If
        Else
            If ActivityCode(j, 1) = "A0003" Then
                    resultArray(i) = Sheets("DeSL_CP").Range("P" & j).Value
                    Exit For
            End If
        End If
    End If
    Next j
Next i

.Range("M7").Resize(lastRow - 7 + 1, 1).Value = resultArray
End With

Временами бывает пустым, но часто нет. Я спрятал много данных, чтобы сосредоточиться на столбцах, которые имеют значение в месячном веке - это имеет значение?

Answer 1

Рад слышать, что вы заставили его работать ...

Что касается вашего вопроса об оригинале, вам понадобится WorksheetFunction.Transpose(resultArray), чтобы он вставился в вертикальный столбец

Не уверен, что еслиэто было бы быстрее, чем

Answer 2

В коде некоторые проблемы, такие как lastRow1 = Sheets("DeSL_CP").Range("A" & Rows.Count).End(xlUp).Row, предпочли основываться на столбце B. Также считают, что начальное значение для циклов For должно быть 1 вместо 7 и 2 (в зависимости от Option Base).ResultArray может быть заполнен непосредственно из BaselineEnd(j, 1).Наконец ResultArray был решен с Range("M7").Resize(UBound(resultArray), 1).Value = resultArray.Консолидированный окончательный код:

    Option Base 1
Sub test()
Sheets("Summary").Select
Dim lastRow As Long, lastRow1 As Long
lastRow = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Row
lastRow1 = Sheets("DeSL_CP").Range("B" & Rows.Count).End(xlUp).Row
lastRow1 = lastRow1 - 1


Dim BaselineEnd As Variant, ActivityCode As Variant, ProductIDDeSL As Variant, Licensed As Variant, ProductIDSumm As Variant
BaselineEnd = ThisWorkbook.Worksheets("DeSL_CP").Range("P2:P" & lastRow1).Value
ActivityCode = ThisWorkbook.Worksheets("DeSL_CP").Range("K2:K" & lastRow1).Value
ProductIDDeSL = ThisWorkbook.Worksheets("DeSL_CP").Range("B2:B" & lastRow1).Value
Licensed = ThisWorkbook.Worksheets("Summary").Range("AK7:AK" & lastRow).Value
ProductIDSumm = ThisWorkbook.Worksheets("Summary").Range("A7:A" & lastRow).Value

Dim resultArray() As Date
ReDim resultArray(lastRow - 7 + 1, 1)
Dim i As Long, j As Long

With ThisWorkbook.Worksheets("Summary")
For i = 1 To UBound(ProductIDSumm)
    For j = 1 To UBound(ProductIDDeSL)
    'If Not Sheets("DeSL_CP").Rows(j).Hidden Then
    If ProductIDSumm(i, 1) = ProductIDDeSL(j, 1) Then
        If Licensed(i, 1) = "Unlicensed" Then
            If ActivityCode(j, 1) = "AA0001" Then
            resultArray(i, 1) = BaselineEnd(j, 1)
            Exit For
            End If
        Else
            If ActivityCode(j, 1) = "A0003" Then
            resultArray(i, 1) = BaselineEnd(j, 1)
            Exit For
            End If
        End If
    End If
    'End If
    Next j
Next i

Range("M7").Resize(UBound(resultArray), 1).Value = resultArray
End With
End Sub

Я попытался просто без какого-либо массива и нашел работоспособным

Sub test2()
Sheets("Summary").Select
Dim lastRow As Long, lastRow1 As Long
Dim i, j As Long, Found As Boolean
lastRow = Range("A" & Rows.Count).End(xlUp).Row
lastRow1 = Sheets("DeSL_CP").Range("B" & Rows.Count).End(xlUp).Row
lastRow1 = lastRow1


Dim BaselineEnd As Variant, ActivityCode As Variant, ProductIDDeSL As Variant, Licensed As Variant, ProductIDSumm As Variant

For i = 7 To lastRow
Found = False
ProductIDSumm = ThisWorkbook.Worksheets("Summary").Cells(i, 1).Value
Licensed = ThisWorkbook.Worksheets("Summary").Cells(i, 37).Value
If ProductIDSumm <> "" Then
    For j = 2 To lastRow1
    ProductIDDeSL = ThisWorkbook.Worksheets("DeSL_CP").Cells(j, 2).Value    'Col B
    ActivityCode = ThisWorkbook.Worksheets("DeSL_CP").Cells(j, 11).Value   'Col K
    BaselineEnd = ThisWorkbook.Worksheets("DeSL_CP").Cells(j, 16).Value    ' Col P
    If ProductIDDeSL <> "" Then              ' to skip blank rows
    If ProductIDSumm = ProductIDDeSL Then
        If Licensed = "Unlicensed" Then
            If ActivityCode = "AA0001" Then
            Found = True
            Exit For
            End If
        Else
            If ActivityCode = "A0003" Then
            Found = True
            Exit For
            End If
        End If
    End If
    End If
    Next j
ThisWorkbook.Worksheets("Summary").Cells(i, 13).Value = IIf(Found, BaselineEnd, "Not Found")
End If
Next i

Редактировать: Поскольку вы предположительно обладаете большими данными и имеете время обработкипроблема.просто из любопытства я добавляю метод поиска решения в качестве третьего варианта

Sub test3()
Sheets("Summary").Select
Dim lastRow As Long, lastRow1 As Long
Dim i, j As Long, Found As Boolean
lastRow = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Row
lastRow1 = Sheets("DeSL_CP").Range("B" & Rows.Count).End(xlUp).Row
lastRow1 = lastRow1
Dim RngIDsm, RngIDde, Cl, Cl2 As Range
Set RngIDsm = Sheets("Summary").Range("A7:A" & lastRow)
Set RngIDde = Sheets("DeSL_CP").Range("B2:B" & lastRow1)
Dim BaselineEnd As Variant, ActivityCode As Variant, ProductIDDeSL As Variant, Licensed As Variant, ProductIDSumm As Variant

For Each Cl In RngIDsm
Found = False
ProductIDSumm = Cl.Value
Licensed = Cl.Offset(, 36).Value
    With RngIDde
    Set Cl2 = .Find(ProductIDSumm, LookIn:=xlValues)
    If Not Cl2 Is Nothing Then
        firstAddress = Cl2.Address
        Do
        ActivityCode = Cl2.Offset(, 9).Value  'Col K
            If Licensed = "Unlicensed" Then
                If ActivityCode = "AA0001" Then
                BaselineEnd = Cl2.Offset(, 14).Value
                Found = True
                Exit Do
                End If
            Else
                If ActivityCode = "A0003" Then
                BaselineEnd = Cl2.Offset(, 14).Value   
                Found = True
                Exit Do
                End If
            End If
        Set Cl2 = .FindNext(Cl2)
        Loop While Not Cl2 Is Nothing And Cl2.Address <> firstAddress
    End If
    End With
Cl.Offset(, 12).Value = IIf(Found, BaselineEnd, "Not Found")
Next Cl
End Sub