EXCEL VBA：我的宏正在创建一个 3D 维数组

Question

I have lots of recruitment data that i want to re-arrange, separate and modify using arrays. The data includes all information from 1st stage, 2nd stage and 3rd stage interview for each candidates. The idea is to separate each stage onto their own sheets (eg Interview 1, interview 2, interview 3). And then to also create a table that has information from all three stages for each candidate.

Firstly, i have created an array of all the data by declaring the range ("A1:AV10000") as a variant.

Then i have created a loop to loop through this data, and separate each type of event that occurs into their own arrays, using an IF function within the loop. If condition is met, create a new array and add each row that condition is met to an array.

However, i believe my arrays are being made into a 3D array and i am sure how to edit the code so that it remains 2Darray. I understand why the code may be creating 3D array (due to iterating by 1 in the loop), however i am unsure how to write code so it includes all data the row and only iterates as shown below.

eg currently it goes (1)(1,1),(1)(1,2) then (2)(1,1),(2)(1,2) then (3)(1,1),(3)(1,2). I would think it would work if it was (1,1)(1,2) then (2,1)(2,2) then (3,1)(3,2). Screenshot of array format from local window

Sub AddProcessStageToArray(SourceWorksheet, RawDataArray, LastrowData, WhatStage, ArrayOutput)

For i = LBound(RawDataArray) To UBound(RawDataArray)
    If RawDataArray(i, 13) = WhatStage And RawDataArray(i, 38) <> "NOK" Then
        o = o + 1

        'Dim ArrayName() As Variant
        ReDim Preserve ArrayOutput(o)
        ArrayOutput(o) = Application.Index(SourceWorksheet.Range("A1:AO" & LastrowData), i, 0)
        
    End If
Next

End Sub

The code is being called as shown below.

Sub AddITWToArray()

Dim DataWs As Worksheet: Set DataWs = ThisWorkbook.Sheets("DATA")
Dim PoolOfWeekWs As Worksheet: Set PoolOfWeekWs = ThisWorkbook.Sheets("Pool of the week")

Dim LastrowData As Long: LastrowData = DataWs.Range("A" & Rows.Count).End(xlUp).Row
Dim LastColData As Long: LastColData = DataWs.Cells(1 & DataWs.Columns.Count).End(xlToLeft).Column

Dim LastColDataString As String: LastColDataString = Split(Cells(1, LastColData).Address, "$")(1)

Dim DataRange As Range: Set DataRange = DataWs.Range("A1:" & LastColDataString & LastrowData)
Dim DataArr As Variant: DataArr = DataWs.Range("A1:AO" & LastrowData)

'Loop through Data array, if interview process = PQL, add to table. If interview proces = 1sTITW find postion and add data, if 2ndITW find postion and highlight, if 3rd find postion and highlight

Dim PoolofWeekTableLRow As Long: PoolofWeekTableLRow = PoolOfWeekWs.Range("A" & Rows.Count).End(xlUp).Row
'PoolOfWeekWs.Rows("3:" & PoolofWeekTableLRow).ClearContents

Dim i, o As Long
Dim RowNumberArr As Variant


'Create PQLArray
Dim PQLArray() As Variant
Call AddProcessStageToArray(DataWs, DataArr, LastrowData, "Prequalification", PQLArray)


'Create 1ITWArray
Dim FirstITWArray() As Variant
Call AddProcessStageToArray(DataWs, DataArr, LastrowData, "Candidate Interview 1", FirstITWArray)

'Create 2ITWArray
Dim SecondITWArray() As Variant
Call AddProcessStageToArray(DataWs, DataArr, LastrowData, "Candidate Interview 2+", SecondITWArray)

'Create PPLArray
Dim PPLArray() As Variant
Call AddProcessStageToArray(DataWs, DataArr, LastrowData, "Candidate Interview 2*", PPLArray)

Answer 1

Try the next adapted function, please:

Function AddProcessStageToArray(SourceWorksheet As Worksheet, RawDataArray, LastrowData As Long, WhatStage As String) As Variant
Dim ArrayOutput() As Variant, o As Long, i As Long, j As Long

ReDim ArrayOutput(1 To UBound(RawDataArray, 2), 1 To UBound(RawDataArray, 2))
For i = LBound(RawDataArray) To UBound(RawDataArray)
    If RawDataArray(i, 13) = WhatStage And RawDataArray(i, 38) <> "NOK" Then
        o = o + 1
        For j = 1 To UBound(RawDataArray, 2)
            ArrayOutput(j, o) = RawDataArray(i, j)
        Next j
    End If
Next
ReDim Preserve ArrayOutput(1 To UBound(RawDataArray, 2), 1 To o)
AddProcessStageToArray = WorksheetFunction.Transpose(ArrayOutput)
End Function

It can be called in this way:

Sub testAddProcessStToArr()
  Dim DataWs As Worksheet, DataArr As Variant, LastrowData As Long
  
  Set DataWs = ThisWorkbook.Sheets("DATA")
    LastrowData = DataWs.Range("A" & rows.count).End(xlUp).row
    DataArr = DataWs.Range("A1:AO" & LastrowData)
    Dim PQLArray() As Variant
    PQLArray = AddProcessStageToArray(DataWs, DataArr, LastrowData, "Prequalification")
    Dim NewSheet as Worksheet
    Set NewSheet = ActiveWorkbook.Sheets.Add
    NewSheet.Range("A1").Resize(UBound(PQLArray), UBound(PQLArray, 2)).Value = PQLArray
End Sub

Edited :

Please, also try the next approach, involving a preliminary counting of rows respecting the conditions criteria and then use them to fill the final array. The adapted function to be used will be the next:

Function AddProcessStageToArr(RawDataArray, arrNo As Variant) As Variant
 Dim ArrayOutput() As Variant, o As Long, i As Long, j As Long

 ReDim ArrayOutput(1 To UBound(arrNo) + 1, 1 To UBound(RawDataArray, 2))
 For i = 0 To UBound(arrNo)
    o = o + 1
    For j = 1 To UBound(RawDataArray, 2)
        ArrayOutput(o, j) = RawDataArray(arrNo(i), j)
    Next j
 Next
 AddProcessStageToArr = ArrayOutput
End Function

The above function should be called in the next way:

Sub testAddProcessStToArrBis()
  Dim DataWs As Worksheet, DataArr As Variant, LastrowData As Long
  Dim arrNo As Variant, i As Long, k As Long
  
  Set DataWs = ActiveSheet
    LastrowData = DataWs.Range("A" & rows.count).End(xlUp).row
    DataArr = DataWs.Range("A1:AO" & LastrowData).Value
    ReDim arrNo(UBound(DataArr))
    For i = 1 To UBound(DataArr)
        If DataArr(i, 13) = "Prequalification" And DataArr(i, 38) <> "NOK" Then
            arrNo(k) = i: k = k + 1
        End If
    Next i
    ReDim Preserve arrNo(k - 1)
    Dim PQLArray() As Variant
    PQLArray = AddProcessStageToArr(DataArr, arrNo)
    Dim NewSheet As Worksheet
    Set NewSheet = ActiveWorkbook.Sheets.Add(After:=DataWs)
    NewSheet.Range("A1").Resize(UBound(PQLArray), UBound(PQLArray, 2)).Value = PQLArray
End Sub

The same function must be used, but changing "Prequalification" with "Candidate Interview x" and rebuild arrNo for each case...