Excel vba二维数组循环停止

时间:2017-01-19 13:57:33

标签: arrays excel vba loops multidimensional-array

作为较长代码的一部分,我试图根据二维字母分配数组为每一行指定特定的人员姓名。 LastRow已被声明并正确拾取,但循环仍然在27次循环后停止,无论如何。如何更正以继续到LastRow?这是我第一次使用多维数组,所以我非常感谢任何帮助。

Private Sub Assignments()
    Dim Alpha As Variant, Staff As Variant
    Dim i As Integer
    Dim LastRow As Long
    Dim alpha_Assignment(1 To 26, 1 To 2) As Variant

    'define last row
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row

    'set alpha column to array and set staff to array
    Alpha = Range("AB2:AB" & LastRow).Value
    Staff = Range("AC2:AC" & LastRow).Value

    'Array Values to Alpha and Assigned staff
    alpha_Assignment(1, 1) = "A"
    alpha_Assignment(1, 2) = "Staff 1"
    alpha_Assignment(2, 1) = "B"
    alpha_Assignment(2, 2) = "Staff 2"
    alpha_Assignment(3, 1) = "C"
    alpha_Assignment(3, 2) = "Staff 3"
    'and so on for all 26 letters in alphabet then loop statement and paste into worksheet.

    For i = 1 To UBound(alpha_Assignment)
        If Alpha(i, 1) = alpha_Assignment(i, 1) Then
            Staff(i, 1) = alpha_Assignment(i, 2)
        ElseIf Alpha(i, 1) <> alpha_Assignment(i, 1) Then
            Staff(i, 1) = "Staff 1"
        End If
    Next i

    Range("AC2").Resize(UBound(Staff, 1), 1).Value = Staff
End Sub

4 个答案:

答案 0 :(得分:0)

你的循环上限是在这里定义的

For i = 1 To UBound(alpha_Assignment)

如果你想让它循环到lastrow然后调整到

For i = 1 To LastRow 

答案 1 :(得分:0)

你的<canvas id="canvas" width="400" height="400"></canvas>从1到for...next的第一个元素的上限,基于Dim是26。

答案 2 :(得分:0)

我会说你需要Redim声明:

'define last row
LastRow = Cells(Rows.Count, "A").End(xlUp).Row

ReDim alpha_Assignment(1 To LastRow, 1 To 2) As Variant

' then loop
For i = LBound(alpha_Assignment) To UBound(alpha_Assignment)
    ' ...
Next i

答案 3 :(得分:0)

这&#34;耦合&#34;工作似乎要求Dictionary对象

如下:

Option Explicit

Private Sub Assignments()
    Dim Alpha As Variant, Staff As Variant
    Dim i As Integer
    Dim LastRow As Long

    'define last row
    LastRow = Cells(Rows.count, "A").End(xlUp).Row

    'set alpha column to array and set staff to array
    Alpha = Range("AB2:AB" & LastRow).Value
    Staff = Range("AC2:AC" & LastRow).Value

    Dim alphaDict As Scripting.Dictionary

    Set alphaDict = New Scripting.Dictionary

    'dictionary with key=Alpha and Item=Assigned staff
    With alphaDict
        .Add "A", "Staff 1"
        .Add "B", "Staff 2"
        .Add "C", "Staff 3"
        .Add "D", "Staff 4"
        .Add "E", "Staff 5"
        .Add "F", "Staff 6"
        'and so on for all 26 letters in alphabet
    End With

    For i = 1 To UBound(Alpha)
        If alphaDict.Exists(Alpha(i, 1)) Then Staff(i, 1) = alphaDict(Alpha(i, 1))
    Next i

    Range("AC2").Resize(UBound(Staff, 1), 1).Value = Staff
End Sub

要使用Dictionary对象,您必须按如下方式为项目添加必要的引用

  • 点击工具 - &gt;参考

  • 将列表框滚动到&#34; Microsoft Scripting Runtime&#34;并勾选其复选标记

  • 点击&#34;确定&#34;