arrays - Excel VBA : Generating a new array from an existing array, 但跳过特定字符串

Question

这是我在 Excel 中尝试做的事情。

简单地说，我正在尝试获取一个二维数组，(1)将其转换为一维数组，(2)循环遍历一维数组，(3)将任何不是特定字符串的值复制到一个新数组中，以及( 4)然后将新的修剪后的一维数组写入特定列。

更复杂地说，我试图取两个二维数组，将它们都转换为匹配的一维数组，循环遍历它们，但只将基于其中一个数组的内容复制到两个不同的数组中，然后将新数组写入两个不同的列(没有很好地解释这一切......)

凭借我在网上找到的基本 VBA 知识，我设法编写了一些代码来完成 (1)、(2) 和 (4)。我遇到的问题是(3)。我似乎无法让它跳过特定的单元格。

有人对如何做到这一点有任何建议吗？

下面是我拼凑的代码。请注意，这是我编写的第一个代码，所以我猜测有更简单、更优雅的方法可以做到这一点；我做了对我有用的事情。任何有关调整的建议将不胜感激!

Sub Calculating()

'Transforming 2D Arrays into 1D Arrays

'Defining the arrays
Dim InputNameArray() As Variant 'Input Names (strings)
Dim InputValueArray() As Variant 'Input Values (numbers)
Dim InputArrayR As Long 'Old Array Row
Dim InputArrayC As Long 'Old Array Column

Dim OldArrayP As Long 'Old Array Position

Dim OldNameArray() As Variant 'One Dimensional Names
Dim OldValueArray() As Variant 'One Dimensional Values

InputNameArray = Range("B3:M10")
InputValueArray = Range("B27:M34")

OldArrayP = 0 'Old Array One Dimensional Position

For InputArrayR = 1 To UBound(InputNameArray, 1)
    For InputArrayC = 1 To UBound(InputNameArray, 2)

        ReDim Preserve OldNameArray(0 To OldArrayP)
        OldNameArray(OldArrayP) = InputNameArray(InputArrayR, InputArrayC)

        ReDim Preserve OldValueArray(0 To OldArrayP)
        OldValueArray(OldArrayP) = InputValueArray(InputArrayR, InputArrayC)

        Debug.Print OldArrayP; OldNameArray(OldArrayP), OldValueArray(OldArrayP)

        OldArrayP = OldArrayP + 1

    Next InputArrayC
Next InputArrayR



'Scanning through 1D Arrays to Eliminate Specific Values

'Defining New Arrays

Dim NewNameArray() As Variant 'New Name Array (Strings)
Dim NewValueArray() As Variant 'New Value Array (Numbers)

Dim NewArrayP As Long 'New Array Position
Dim OldArrayPosition As Long 'Old Array Position

NewArrayP = 0

For OldArrayPosition = LBound(OldNameArray) To UBound(OldNameArray)
    If OldNameArray(OldArrayPosition) <> "Blank" Or OldNameArray(OldArrayPosition) <> "Standard-100" Or OldNameArray(OldArrayPosition) <> "Standard-50" Or OldNameArray(OldArrayPosition) <> "Standard-25" Or OldNameArray(OldArrayPosition) <> "Standard-12.5" Or OldNameArray(OldArrayPosition) <> "Standard-6.25" Or OldNameArray(OldArrayPosition) <> "Standard-3.125" Or OldNameArray(OldArrayPosition) <> "Standard-1.5625" Or OldNameArray(OldArrayPosition) <> "Standard-0.7825" Then
        ReDim Preserve NewNameArray(0 To NewArrayP)
            NewNameArray(NewArrayP) = OldNameArray(OldArrayPosition)
        ReDim Preserve NewValueArray(0 To NewArrayP)
            NewValueArray(NewArrayP) = OldValueArray(OldArrayPosition)

        Debug.Print OldArrayPosition, OldNameArray(OldArrayPosition), OldValueArray(OldArrayPosition)
        Debug.Print NewArrayP, NewNameArray(NewArrayP), NewValueArray(NewArrayP)

        NewArrayP = NewArrayP + 1
    End If
Next OldArrayPosition

'Outputing Values

'Defining Variables

Dim OutputPosition As Long 'Output Array Position
Dim OutputRow As Long 'Output Row

OutputRow = 3

For OutputPosition = LBound(NewNameArray) To UBound(NewNameArray)
    Cells(OutputRow, "O").Value = NewNameArray(OutputPosition)
    Cells(OutputRow, "Q").Value = NewValueArray(OutputPosition)

    Debug.Print OutputRow, OutputPosition, NewNameArray(OutputPosition), NewValueArray(OutputPosition)

    OutputRow = OutputRow + 1
Next OutputPosition


'Cleaning Up

Erase InputNameArray
Erase InputValueArray
Erase OldNameArray
Erase OldValueArray
Erase NewNameArray
Erase NewValueArray

End Sub

Answer 1

您的代码非常合乎逻辑。错误是在 If 语句中使用了 Or；将它们切换到 And 并且代码应该可以工作。

您可以避免操作所有这些数组，可能类似于下面的内容。我命名了输入范围，以便更容易调整它们的大小。如果您喜欢这样，您可能希望对输出范围执行相同的操作。

虽然我知道这是非常标准的 VBA 实践，但我真的非常不喜欢异常作为流控制，因此冗长的 Exists方法;您可能更喜欢提到的替代方案here . (对于如此小的数据集，它不会对性能产生影响)。

最后，我有点懒了。网上有很多“最佳实践”资源可供您阅读，例如 this .

Option Explicit

Private Function Exists(ByRef col As Collection, ByRef key As Variant) As Boolean
  Dim Iter As Long

  For Iter = 1 To col.Count
    If key = col.Item(Iter) Then
      Exists = True
      Exit Function
    End If
  Next Iter

  Exists = False
End Function

Sub Calculating()
  Dim NamesToSkip As Collection

  Dim NameArray As Range
  Dim ValueArray As Range
  Dim OutputRange As Range
  Dim Rows As Long
  Dim Columns As Long
  Dim Row As Long
  Dim Column As Long
  Dim Iter As Long

  Set NamesToSkip = New Collection
  NamesToSkip.Add "Blank"
  NamesToSkip.Add "Standard-100"
  NamesToSkip.Add "Standard-50"
  NamesToSkip.Add "Standard-25"
  NamesToSkip.Add "Standard-12.5"
  NamesToSkip.Add "Standard-6.25"
  NamesToSkip.Add "Standard-3.125"
  NamesToSkip.Add "Standard-1.5625"
  NamesToSkip.Add "Standard-0.7825"

  Set NameArray = Range("InputNames")
  Set ValueArray = Range("InputValues")
  Set OutputRange = Range("O3")

  Rows = NameArray.Rows.Count
  Columns = NameArray.Columns.Count

  If Rows <> ValueArray.Rows.Count Or Columns <> ValueArray.Columns.Count Then
    Err.Raise vbObjectError + 513, "Calculating()", "Mismatched sizes of input arrays"
  End If

  Iter = 1
  For Row = 1 To Rows
    For Column = 1 To Columns
      If Not Exists(NamesToSkip, NameArray.Cells(Row, Column)) Then
        OutputRange.Cells(Iter, 1) = NameArray.Cells(Row, Column)
        OutputRange.Cells(Iter, 3) = ValueArray.Cells(Row, Column)
        Iter = Iter + 1
      End If
    Next Column
  Next Row

  Set NamesToSkip = Nothing
End Sub