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

Question

我无法解决以下问题，非常感谢您的帮助。

我有一个二维数组，看起来像下面这样; PFAllArr 我想从中创建一个新数组（PFArr），但是不包括已删除 =“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

- Stephen

---

你想要从 c1 等于 0 开始。 - urdearboy

这就做到了，亲爱的男孩 - 非常感谢你！ - Stephen

以下有三个解决方案。您应该接受其中一个，以表彰那些捐赠时间来帮助他人的人们 :) - urdearboy

啊，我明白了。我不知道这一点。我以为赞数决定了这个。再次感谢。 - Stephen

啊，我明白了。我不知道这一点。我以为赞数决定了这个。再次感谢。 - Stephen

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

- tigeravatar

---

这看起来比我的代码要漂亮得多，谢谢tigeravatar！我已经按照urdearboys上面的建议让我的代码工作了。我可以看出你的方法更有效率，将来会采用它。 - Stephen

Answer 2

两件事情

1. 你需要将c1从1改为0。如果你正确地声明了变量类型，你可以不设置初始值。 Long类型的变量默认为0，除非另有说明。
2. 你的变量块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

在我看来，@tigeravatar的解决方案更为简洁。无论你最终使用哪个代码，了解为什么自己的代码没有成功总是一个好的体验。

- urdearboy

---

非常好的解释了OP遇到的问题以及如何进行修正，点赞！ - tigeravatar

很好的解释 +1，也许你会对我的方法感兴趣。 - T.M.

是的，对于弄清楚自己的代码为什么不能工作，这绝对是真实的。通过修复它，我学到了很多东西，如果我不修复它，它会让我头痛数周 :) - Stephen

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

辅助函数 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

- T.M.