Question

我无法解决以下问题，我们将不胜感激

我有一个二维数组，如下所示；

我想从中创建一个新数组（PFArr），但没有其中delete =“ yes”的行。我可以使这个新数组的大小与原始数组相同，只是在空白行中保留了删除数据的位置，但是该数组将在代码的众多循环中使用，因此我希望使其尽可能紧凑。

使用下面的代码，我尝试使用循环获取删除的元素数量= 0（我想保留）。

然后将新数组重新调整为该大小。

然后，应使用第二个循环将旧数组的相关元素分配给新数组。但是，它没有按预期的那样将元素分配到数组中，似乎循环良好，只是没有在其中添加新元素。有什么想法吗？

Sub AddSelectDataFromBigArrayToSmallOne()

Dim PFAllArr As Variant
Dim PFArr As Variant
Dim c1, i1, c2, i2 As Long

PFAllArr = Sheets("PF File Simple").Range("A2").CurrentRegion.Value

'get number of elements i want to transfer to new array
c1 = 1
For i1 = LBound(PFAllArr) To UBound(PFAllArr)
    If PFAllArr(i1, 2) = 0 Then
    c1 = c1 + 1
    End If
Next i1

'Make new array this size
ReDim PFArr(LBound(PFAllArr) To c1, 1 To 4)

'Assign elements from old array nto new one
c2 = 1
For i2 = LBound(PFAllArr) To UBound(PFAllArr)
    If PFAllArr(i2, 2) = 0 Then
    PFArr(c2, 3) = PFAllArr(i2, 3)
    PFArr(c2, 4) = PFAllArr(i2, 4)
    c2 = c2 + 1
    End If
    Debug.Print c2, PFArr(c2, 3), PFArr(c2, 4)
Next i2

End Sub

Answer 1

也许是这样吗？

Sub tgr()

    Dim aTemp As Variant
    Dim aData As Variant
    Dim iyTemp As Long
    Dim iyData As Long
    Dim ix As Long

    With ActiveWorkbook.Sheets("PF File Simple").Range("A2").CurrentRegion
        aTemp = .Value
        ReDim aData(1 To WorksheetFunction.CountIf(.Resize(, 1).Offset(, 1), 0), 1 To .Columns.Count)
    End With

    For iyTemp = 1 To UBound(aTemp, 1)
        If aTemp(iyTemp, 2) = 0 Then
            iyData = iyData + 1
            For ix = 1 To UBound(aTemp, 2)
                aData(iyData, ix) = aTemp(iyTemp, ix)
            Next ix
        End If
    Next iyTemp

    'aData is now populated with only values where the second column is 0

End Sub

Answer 2

两件事

您需要将c1更改为从 1 开始的 0 。如果正确声明变量类型，则不能设置初始值。除非另有说明，否则Long类型变量将默认为 0
您的变量块Dim c1, i1, c2, i2 As Long无法正常工作。您实际上是在将i2声明为Long，其余的变量都被压入了Variant类型的变量中。这部分的重要性不高，但在该主题上却细细细腻：您也可以只使用Dim PFAllArr, PFArr，这些默认为Variant

因此，您可以像这样开始代码（删除了c1集，并更新了行以按预期声明变量）：

Sub AddSelectDataFromBigArrayToSmallOne()

Dim PFAllArr, PFArr
Dim c1 as Long, i1 as Long, c2 as Long, i2 As Long

PFAllArr = Sheets("PF File Simple").Range("A2").CurrentRegion.Value

For i1 = LBound(PFAllArr) To UBound(PFAllArr)
    If PFAllArr(i1, 2) = 0 Then
    c1 = c1 + 1
    End If
Next i1

IMO，@ tigeravatar的解决方案看起来更干净。无论您最终使用哪种代码，总是很高兴知道为什么您的代码不起作用

Answer 3

使用Application.Index

您可以使用Index函数的高级过滤功能：

主要过程

Sub DelRows()
  Dim PFAllArr, PFArr
' [1a] create 2-dim data field array (1-based)
  PFAllArr = ThisWorkbook.Worksheets("PF File Simple").Range("A2").CurrentRegion.Value2
' [1b] filter out rows to be deleted
  PFArr = Application.Transpose(Application.Index(PFAllArr, getAr(PFAllArr, 2), Evaluate("row(1:" & UBound(PFAllArr, 2) & ")")))
End Sub

Helper函数getAr（）

Function getAr(v, ByVal colNo&) As Variant()
' Purpose: collect row numbers not to be deleted (criteria <> "YES" in 2nd column)
' Note:    called by above procedure DelRows
  Dim ar, i&, n&
  ReDim ar(0 To UBound(v) - 1)
  For i = 1 To UBound(v)
      If UCase$(v(i, colNo)) <> "YES" Then
         ar(n) = i: n = n + 1
      End If
  Next i
  ReDim Preserve ar(0 To n - 1): getAr = ar
End Function

从较大的二维数组创建二维数组

3 个答案:

两件事