Excel VBA：从现有的数组中生成一个新的数组，但跳过特定的string

这是我在Excel中想要做的。

简单地说，我试图采取二维数组，（1）将其转换为一维数组，（2）循环通过1D数组，（3）将任何非特定string的值复制到一个新的数组，（ 4）然后将新的，修剪的一维数组写入特定的列。

更复杂的说，我试图采取两个二维数组，将它们都转换为匹配的一维数组，循环它们两个，但只是将基于其中一个数组的内容复制到两个不同的数组，然后将新数组写入两个不同的专栏（没有解释，所有这一切…）

有了我的基本知识VBA知识，从我能在网上find的拼凑在一起，我不知何故设法写一些代码，完成（1），（2）和（4）。 我遇到的问题是（3）。 我似乎无法让它跳过特定的单元格。

有没有人有任何build议如何做到这一点？

下面是我拼凑在一起的代码。 预先警告，这是我写的第一个代码，所以我猜测有更简单更优雅的方法来做到这一点。 我做了什么为我工作。 任何意见的调整将不胜感激！

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; 切换到和和代码应该工作。

你可以避免操纵所有这些数组，或许像下面这样。 我将input范围命名为使其更容易resize。 如果你喜欢这个，你可能想在输出范围内做同样的事情。

虽然我知道这是相当标准的VBA练习，但我确实不喜欢例外的stream量控制，因此Exists方法冗长了; 你可能更喜欢这里提到的替代scheme。 （这样的小数据集性能没有什么不同）。

最后，我有点懒惰。 网上有很多“最佳实践”资源，例如你可能想要通读一遍。

 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