仅存储来自另一个数组的数组中的特定值

时间:2018-02-23 13:39:34

标签: excel vba excel-vba

这个sub的目标是运行一个现有的数组,其中所有值存储在数组槽中,包含String" Score"是没用的,以及在这个插槽之后和包含字符串的插槽之前的所有插件"为什么?"很有意义。所以数组看起来像这样:

IQRngRef(0).Value2(1) = "Pineapple"
IQRngRef(0).Value2(2) = "Apple"
IQRngRef(0).Value2(3) = "Lemons"
IQRngRef(0).Value2(4) = "Score"
IQRngRef(0).Value2(5) = "23"
IQRngRef(0).Value2(6)= "45"
IQRngRef(0).Value2(7) = "333"
IQRngRef(0).Value2(8) = "Why?"
IQRngRef(0).Value2(9) = "77"
IQRngRef(0).Value2(10) = "60"

然后我想将值{23 | 45 | 333}存储到数组roleArray()中。以下是我提出的建议,但我确信这是一种更简单/更有效的方式。

此外,这是我run-time error 451 property let procedure not defined and property get procedure did not return an object这一行:roleIdentifier = IQRngRef(0).Value2(rowIterator)我无法弄清楚如何修复它。

非常感谢任何帮助。

Private Sub IdentifyRolesAndScoresRows(ByRef IQRngRef As Variant, ByVal rowNumb As Long)
    Dim rowIterator As Long
    Dim roleIdentifier As String

    Do Until roleIdentifier = "Score"
        For rowIterator = 1 To rowNumb
            roleIdentifier = IQRngRef(0).Value2(rowIterator)
        Next rowIterator
    Loop

    Dim roleArray(1 To 10) As String
    Dim roleArrayCount As Long
    Do Until roleIdentifier = "Why?"
        For rowIterator = rowIterator + 1 To rowNumb
            roleIdentifier = IQRngRef(0).Value2(rowIterator)
            roleArrayCount = roleArrayCount + 1
            roleArray(roleArrayCount) = roleIdentifier
        Next rowIterator
    Loop
End Sub

这是填充IQRngRef()

的代码
Private Sub CaptureIQRefsLocally(ByVal ShRef As Worksheet, ByVal rowNumb As Long, ByVal colNumb As Long, ByRef IQRef As Variant, ByRef IQRngref As Variant)
    'capture IQ references in arrays. Values for column titles in IQRef and full column Ranges in IQRngRef.
    Dim iCol As Long
    Dim alignIQNumbToArrayNumb As Long
    With ShRef
        For iCol = 1 To colNumb
            alignIQNumbToArrayNumb = iCol - 1
            Set IQRngref(alignIQNumbToArrayNumb) = .Range(.Cells(1, iCol), .Cells(rowNumb, iCol))
            IQRef(alignIQNumbToArrayNumb) = .Cells(1, iCol).Value
            'IsThisaKeyIQ IQRngref, IQRef
        Next iCol
    End With
End Sub

2 个答案:

答案 0 :(得分:1)

看看你是否可以根据自己的具体情况进行调整。

Sub x()

Dim v(1 To 10), n1 As Long, n2 As Long, v1, i As Long

v(1) = "Pineapple"
v(2) = "Apple"
v(3) = "Lemons"
v(4) = "Score"
v(5) = "23"
v(6) = "45"
v(7) = "333"
v(8) = "Why?"
v(9) = "77"
v(10) = "60"

n1 = Application.Match("Score", v, 0)
n2 = Application.Match("Why?", v, 0)

v1 = Application.Index(v, Evaluate("ROW(" & n1 + 1 & ":" & n2 - 1 & ")"))

For i = LBound(v1) To UBound(v1)
    MsgBox v1(i, 1)
Next i

End Sub

答案 1 :(得分:1)

您必须使用"一维变体数组的变体数组" (即Variant / Variant)然后根据This Link

的Application.Index函数对后者进行切片。

所以,首先更改CaptureIQRefsLocally() sub,如下所示:

Private Sub CaptureIQRefsLocally(ByVal ShRef As Worksheet, ByVal rowNumb As Long, ByVal colNumb As Long, ByRef IQRef As Variant, ByRef IQRngref As Variant)
    'capture IQ references in arrays. Values for column titles in IQRef and full column Ranges values in IQRngRef.
    Dim iCol As Long
    Dim alignIQNumbToArrayNumb As Long
    With ShRef
        For iCol = 1 To colNumb
            alignIQNumbToArrayNumb = iCol - 1
            IQRngref(alignIQNumbToArrayNumb) = Application.Transpose(.Range(.Cells(1, iCol), .Cells(rowNumb, iCol)).Value) ' make an 1D array out of range values and store it in current 'IQRngref' element
            IQRef(alignIQNumbToArrayNumb) = .Cells(1, iCol).Value
            'IsThisaKeyIQ IQRngref, IQRef
        Next iCol
    End With
End Sub

然后更改IdentifyRolesAndScoresRows() sub,如下所示:

Private Sub IdentifyRolesAndScoresRows(ByRef IQRngref As Variant, ByVal rowNumb As Long)
    Dim startIndex As Long, endIndex As Long

    startIndex = Application.Match("Score", IQRngref(0), 0)
    endIndex = Application.Match("Why?", IQRngref(0), 0)

    Dim roleArray As Variant

    roleArray = Application.Transpose(Application.Index(IQRngref(0), Evaluate("ROW(" & startIndex + 1 & ":" & endIndex - 1 & ")"))) ' from https://www.mrexcel.com/forum/excel-questions/927644-split-array-vba-2.html
End Sub