Excel VBA查找行中的所有值，并将不同的列值保存到变量中

我已经做了相当多的搜索，找不到任何符合我的情况或我可以修改的代码，除了一个

查看下面的电子表格。我想让用户输入

OrderNumber

，然后搜索

列A

，查找该数字的每个值。正如它所做的那样，我希望它将

ItemNumber

和

QtyOrdered

复制到两个不同的变量中，以便稍后将它们放入文本框中

我希望它将信息“堆叠”到变量中，这样类似于

ItemNumValues=ItemNumValues+Cell.Value

我试图修改其他人的代码（“他们的代码”），但我得到了一个类型不匹配的错误。代码的其余部分工作正常。脚本中有一些以前功能中的跟踪元素没有使用，我只是还没有删除它们

'***********************************************************
'********** Their Code Follows *****************
'***********************************************************

    Dim numentries As Integer
    Dim i As Integer
    '***********************************************************

    'Get number of entries
    numentries = Worksheets(Sheet1).UsedRange.Rows.Count
    '*************************************************************

    'Run loop to cycle through all entries (rows) to copy
    For i = 1 To numentries

         If (Worksheets("Sheet1").Cells(i + 2, 1).Value = InStr(1, Cell, OrderNumber, vbTextCompare)) Then
              MsgBox Test
        End If

    Next i

End If   

'***********************************************************
'********** End Their Code *****************
'***********************************************************

---

我建议使用多维数组。如果您以前从未使用过数组，我强烈建议您仔细阅读它们

Sub GatherData()
Dim c As Range
Dim aGetData() As Variant 'This is our array
Dim i As Integer
Dim a As Integer
Dim iRowCount As Integer
Dim sRange As String

'Gather data
iRowCount = Worksheets("Sheet1").UsedRange.Rows.Count
For Each c In Range("A2:A" & iRowCount)
  If c.Value = 636779 Then
    ReDim Preserve aGetData(2, i) 'An array must have a set size but as we
    'do not know how many order numbers will be found we have to 'resize'
    'the array to account for how many we do find. Using "ReDim Preserve" 
    'keeps any data we have placed into the array while at the same time
    'changing it's size.
    For a = 0 To 2 'Our first index will hold each col of data that is why
                   'it is set to 2 (arrays start at a base of zero, so
                   '0,1,2 will be each col(A,B,C)
      aGetData(a, i) = c.Offset(0, a) 'This gets each value from col A,B and C
    Next a
    i = i + 1 'Increment for array in case we find another order number
              'Our second index "aGetData(index1,index2) is being resized 
              'this represents each order number found on the sheet
  End If
Next c

'How to read the array
For i = 0 To UBound(aGetData())
  For a = 0 To 2
    Debug.Print aGetData(a, i)
  Next a
Next i
End Sub

---

我建议使用多维数组。如果您以前从未使用过数组，我强烈建议您仔细阅读它们

Sub GatherData()
Dim c As Range
Dim aGetData() As Variant 'This is our array
Dim i As Integer
Dim a As Integer
Dim iRowCount As Integer
Dim sRange As String

'Gather data
iRowCount = Worksheets("Sheet1").UsedRange.Rows.Count
For Each c In Range("A2:A" & iRowCount)
  If c.Value = 636779 Then
    ReDim Preserve aGetData(2, i) 'An array must have a set size but as we
    'do not know how many order numbers will be found we have to 'resize'
    'the array to account for how many we do find. Using "ReDim Preserve" 
    'keeps any data we have placed into the array while at the same time
    'changing it's size.
    For a = 0 To 2 'Our first index will hold each col of data that is why
                   'it is set to 2 (arrays start at a base of zero, so
                   '0,1,2 will be each col(A,B,C)
      aGetData(a, i) = c.Offset(0, a) 'This gets each value from col A,B and C
    Next a
    i = i + 1 'Increment for array in case we find another order number
              'Our second index "aGetData(index1,index2) is being resized 
              'this represents each order number found on the sheet
  End If
Next c

'How to read the array
For i = 0 To UBound(aGetData())
  For a = 0 To 2
    Debug.Print aGetData(a, i)
  Next a
Next i
End Sub

---

看起来，

OrderNumber

（列

A

）已排序。非常好的消息（如果不是，就对它们进行排序；）。这个简单的函数将把

ItemNumber

s和

QtyOrdered

放入一个二维数组，其中每一行是它们的一对

Function ArrItemQty(ByVal OrderNumber As Long)
With Worksheets("Sheet1").UsedRange.Offset(1)
        .AutoFilter 1, OrderNumber
        ArrItemQty= .Resize(, 2).Offset(, 1).SpecialCells(xlCellTypeVisible).value
        .Parent.AutoFilterMode = False
    End With
End Function

这里有一个小测试：

Sub Test()
    Dim i As Long, j As Long, ar
    ar = ArrItemQty(636779)
    For i = LBound(ar, 1) To UBound(ar, 1)
         Debug.Print
         For j = LBound(ar, 2) To UBound(ar, 2): Debug.Print ar(i, j),: Next
     Next
End Sub

---

p、 请注意，生成的数组是基于1的。使用所示的

LBound

和

UBound

是最安全的。

似乎

订单号

（列

A

）已排序。非常好的消息（如果不是，就对它们进行排序；）。这个简单的函数将把

ItemNumber

s和

QtyOrdered

放入一个二维数组，其中每一行是它们的一对

Function ArrItemQty(ByVal OrderNumber As Long)
With Worksheets("Sheet1").UsedRange.Offset(1)
        .AutoFilter 1, OrderNumber
        ArrItemQty= .Resize(, 2).Offset(, 1).SpecialCells(xlCellTypeVisible).value
        .Parent.AutoFilterMode = False
    End With
End Function

这里有一个小测试：

Sub Test()
    Dim i As Long, j As Long, ar
    ar = ArrItemQty(636779)
    For i = LBound(ar, 1) To UBound(ar, 1)
         Debug.Print
         For j = LBound(ar, 2) To UBound(ar, 2): Debug.Print ar(i, j),: Next
     Next
End Sub

---

p、 请注意，生成的数组是基于1的。使用所示的

LBound

和

UBound

最安全。

当Len（订单号）<6或Len（订单号）>6时，错误发生在哪一行。。。VBA有

操作符…很难跟踪您的代码。发布一个更完整的问题描述，或者，最好尽量减少它，以便我们更好地了解您想要实现的目标。

numentries=Worksheets（Sheet1）。UsedRange.Rows.Count

是错误的。它应该是

numentries=Worksheets（“Sheet1”）.UsedRange.Rows.Count

另外，什么是

单元格

<代码>=InStr（1，单元格，订单号，vbTextCompare））然后…当Len（订单号）<6或Len（订单号）>6时，错误发生在哪一行。。。VBA有

操作符…很难跟踪您的代码。发布一个更完整的问题描述，或者，最好尽量减少它，以便我们更好地了解您想要实现的目标。

numentries=Worksheets（Sheet1）。UsedRange.Rows.Count

是错误的。它应该是

numentries=Worksheets（“Sheet1”）.UsedRange.Rows.Count

另外，什么是

单元格

<代码>=InStr（1，单元格，订单号，vbTextCompare））然后…谢谢您的回答。我已经开始改编Craig的答案，并使之生效，所以我没有尝试你的答案。@Travis，欢迎你。但是，请注意，

ReDim

尽可能避免在数组逐元素增长时对其进行重拨；因为对于大数据来说它可能会变得非常慢。谢谢你的回答。我已经开始改编Craig的答案，并使之生效，所以我没有尝试你的答案。@Travis，欢迎你。但是，请注意，

ReDim

尽可能避免在数组逐元素增长时对其进行重拨；因为对于大数据，它可能变得非常慢。