Есть ли способ перейти в строку 2D-массива И через нее?

#excel #vba

#excel #vba

Вопрос:

Используя VBA, я хотел бы перейти к каждой строке в 2D-массиве и выделить результат в отдельный 1D-массив, не добавляя ни одной пары, а также результат со следующим элементом в этой строке. Строка.

К вашему сведению, я впервые использую 2D-массивы, поэтому извините, если есть очевидное решение.

Например, если данные на моем листе выглядели так (фактический диапазон намного больше):

введите описание изображения здесь

Я хотел бы выполнить уравнение формулы Excel: =И (B2: D2), затем = И (B3: D3) и т.д…

У меня есть код, который все настраивает, но я не знаю, как поступить, кроме как выполнить цикл по каждому элементу строки, сохранить результат, затем выполнить цикл по следующему и т.д. и т.п. Я надеюсь, что есть гораздо лучший (более эффективный) способ продолжить.

Вот мой код на данный момент

 Sub Exceptions()
    ' Setup worksheet
    Dim wks As Worksheet
    Set wks = cnTest
        
    ' Find last row of range
    Dim LastRow As Long
    LastRow = Find_LastRow(wks)   'Functionthat returns last row
             
    ' load range into array
    Dim MyArray As Variant
    MyArray = wks.Range("B2:D8")
    
    ' Setup 1D Result array
    Dim Results As Variant
    Results = wks.Range("A2:A8")
    

    Dim i As Long
    For i = 1 To LastRow
        ' Perform AND function on each row of the array
        ' then place result in 1D array (Results())
        ' If this were a formul: =AND(B2:D2)
        '
        ' Is there way to "AND" across a row in and array or
        ' must I "AND" MyArray(1,1) with MyArray(1,2) then AND
        ' that result with MyArray(1,3)
    Next i
          
End Sub
  

Спасибо

Комментарии:

1. Кстати, обратите внимание, что Results = wks.Range("A2:A8") это 2D-массив, а не 1D-массив.

Ответ №1:

Попробуйте это.

 Sub Exceptions()
    ' Setup worksheet

        

             
    ' load range into array
    Dim MyArray As Variant
    MyArray = ActiveSheet.Range("B2:D8")
    
    ' Setup 1D Result array
    Dim Results As Variant
    Results = ActiveSheet.Range("A2:A8")

    Dim i As Long
    Dim X As Long
    For i = 1 To UBound(MyArray, 1)
        Results(i, 1) = "True"
        For X = 1 To UBound(MyArray, 2)
            If MyArray(i, X) = False Then
                Results(i, 1) = "False"
                Exit For
            End If
        Next X
    Next i
End Sub
  

Комментарии:

1. Вы можете сократить и сохранить IF .. Удалите If X = UBound(MyArray, 2) ... End if и, сразу после For i =.. вставки строки Results(i, 1) = True

Ответ №2:

Попробуйте,

 Sub test()
    Dim vR()
    Dim rngDB As Range, rng As Range
    Dim i As Long, r As Long
    
    Set rngDB = Range("b2:b8")
    r = rngDB.Rows.Count
    ReDim vR(1 To r)
    
    For Each rng In rngDB
        i = i   1
        vR(i) = WorksheetFunction.And(rng.Resize(1, 3))
    Next rng
    Range("a2").Resize(r) = WorksheetFunction.Transpose(vR)
End Sub
  

Ответ №3:

В строке формул введите:

 =IF(-PRODUCT(IF(A1,-1,0),IF(C1,-1,0)),TRUE,FALSE)
  

(если данные находятся в столбцах A и C) и перетащите вниз.

Потому что, как всем известно, A AND B = AB if A и B являются логическими переменными (и следите за минусом перед PRODUCT ).