使用字符串作为索引添加到VBA中的数组

时间:2013-05-08 17:50:04

标签: arrays excel vba vbscript

不确定我是否正确标记了这一点。

我有一堆包含数据字符串的单元格。每个单元格都包含以下内容:

q1 = 1   | q2 = 3.2 | q3 = 5.6
q1 = 1.8 | q3 = 2.1 | q5 = 1.4

*注意:分隔符是litteral,所有文本都在单个单元格中,带有管道字符。

我想遍历每个单元格,通过管道(|)分隔符爆炸(使用PHP术语),然后通过=符号再次执行此操作。

我想为等号左边的每个可能值创建一个数组,并将找到的值添加到数组中(不要添加为总和,添加为追加到数组中)。

从视觉上看,我认为数组应该是这样的:

Vars[
q1 [ 1,1.8 ],
q2 [ 3.2 ],
q3 [ 5.6,2.1]....] 

最终目标是我想得到每个q1,q2和q3的平均值,平均值和中位数。

这在VB中可行吗?我对PHP比较熟悉,但是想把它保存在Excel中。

感谢。

2 个答案:

答案 0 :(得分:1)

这很复杂,但可以做到。我根据您的单元格输入在excel中对此进行了测试,将它们放在A1和A2中:

q1 = 1   | q2 = 3.2 | q3 = 5.6
q1 = 1.8 | q3 = 2.1 | q5 = 1.4

我在Excel中放了一个名为“Looper”的宏,它使用两个循环来循环遍历A列中的单元格,将它们拆分为“|”并搜索每个数字值,将其转换为double并将其放在相应的数组中。

Private Sub Looper()

''Loop Variables
Dim i, k As Integer
Dim MoveDown As String

''Variables to manipulate the string
Dim Selecter As String
Dim TotalCell As String
Dim Splitter As Variant
Dim strIncrement As String

''Array variables and counters
Dim q1(50) As Double
Dim q2(50) As Double
Dim q3(50) As Double
Dim qv1, qv2, qv3 As Integer

''Variables for finding the number in each increment
Dim Equals As Integer
Dim strNumber As String
Dim dblNumber As Double

''Set the array counters to 0
qv1 = 0
qv2 = 0
qv3 = 0

i = 0

Do Until MoveDown = "DONE"
    Selector = "A" + Replace(Str(i), " ", "")
    If Range(Selector).Value = "" Then
        MoveDown = "DONE"
    Else
        TotalCell = Range(Selector).Value
        Splitter = Split(TotalCell, "|")
        For k = LBound(Splitter) To UBound(Splitter)
            ''strIncrement holds the data in between each |
            strIncrement = Splitter(k)
            ''Remove any spaces
            strIncrement = Replace(strIncrement, " ", "")
            ''Equals shows the location of the number (length of string - loc of =)
            Equals = Len(strIncrement) - InStr(1, strIncrement, "=")
            strNumber = Right(strIncrement, Equals)
            dblNumber = CDbl(strNumber)
            ''Check for the array name and then add the data to the corresponding array
            If InStr(1, strIncrement, "q1") > 0 Then
                q1(qv1) = dblNumber
                qv1 = qv1 + 1
            Else
                If InStr(1, strIncrement, "q2") > 0 Then
                    q2(qv2) = dblNumber
                    qv2 = qv2 + 1
                Else
                    If InStr(1, strIncrement, "q3") > 0 Then
                        q3(qv3) = dblNumber
                        qv3 = qv3 + 1
                    End If
                End If
            End If
        Next

    End If
    i = i + 1
Loop
End Sub

我能够成功地将数据添加到数组中,因此从那里开始计算方法等应该很简单。

答案 1 :(得分:1)

这将处理任意数量的“键”(q1,q2等)

Sub Tester()

'needs a reference to microsoft scripting runtime
Dim d As New Scripting.dictionary

Dim c As Range
Dim arrP, arrE
Dim q, v, tmpV, tmpP, tmpArr, uB
Dim i As Long, n As Long
Dim k

    For Each c In Selection.Cells
        tmpV = Trim(c.Value)

        If InStr(tmpV, "=") > 0 Then
            arrP = Split(tmpV, "|") 'split on pipe

            For i = LBound(arrP) To UBound(arrP)
                tmpP = arrP(i)

                If InStr(tmpP, "=") > 0 Then
                    q = Trim(Split(tmpP, "=")(0))
                    v = Trim(Split(tmpP, "=")(1))

                    If IsNumeric(v) Then
                        If Not d.exists(q) Then
                            d.Add q, Array(v)
                        Else
                            tmpArr = d(q) 'get dict value into temp array
                            uB = UBound(tmpArr) + 1
                            ReDim Preserve tmpArr(0 To uB) 'extend array
                            tmpArr(uB) = v
                            d(q) = tmpArr 'put back into dict
                        End If
                    End If
                End If
            Next

        End If 'cell has at least one "="

    Next c

    'dump the dictionary to the immediate pane
    For Each k In d.keys
        Debug.Print k, Join(d(k), ",")
    Next k


End Sub