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

Question

我有很多招聘数据，我想使用数组重新排列、分离和修改。数据包括每个候选人的第一阶段、第二阶段和第三阶段面试的所有信息。这个想法是将每个阶段分开到自己的工作表上（例如面试 1、面试 2、面试 3）。然后还要创建一个表格，其中包含每个候选人的所有三个阶段的信息。

首先，我通过将范围 ("A1:AV10000") 声明为变量来创建所有数据的数组。

然后我创建了一个循环来遍历这些数据，并使用循环中的 IF 函数将发生的每种类型的事件分离到它们自己的数组中。如果满足条件，则创建一个新数组并将满足条件的每一行添加到数组中。

但是，我相信我的数组正在制作成 3D 数组，并且我确定如何编辑代码以使其保持 2Darray。我理解为什么代码可能会创建 3D 数组（由于在循环中迭代 1），但是我不确定如何编写代码，以便它包含该行的所有数据并且只迭代如下所示。

例如目前它是 (1)(1,1),(1)(1,2) 然后是 (2)(1,1),(2)(1,2) 然后是 (3)(1,1),(3 )(1,2)。 我认为如果它是（1,1）（1,2）然后是（2,1）（2,2）然后是（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

正在调用代码，如下所示。

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

请尝试下一个改编的功能：

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

可以这样调用：

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

已编辑：

请也尝试下一种方法，包括根据条件标准对行进行初步计数，然后使用它们来填充最终数组。要使用的适配函数将是下一个：

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

上面的函数应该按下面的方式调用：

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

必须使用相同的功能，但将“资格预审”更改为“候选人面试 x”并为每个案例重新构建 arrNo...