Excel VBA二维数组循环停止

Question

作为较长代码的一部分，我试图根据二维字母分配数组为每行分配特定的人员名称。 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

Answer 1

您的循环上限在这里定义

For i = 1 To UBound(alpha_Assignment)

如果您希望它循环播放，则将其调整为

For i = 1 To LastRow 

Answer 2

您的for...next从1到基于Dim为26的alpha_assignment的第一个元素的alpha_assignment 。

Answer 3

我会说您需要在这里使用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

Answer 4

这项“耦合”工作似乎需要使用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对象，您必须向项目添加必要的引用，如下所示

• 单击工具->引用

• 向下滚动列表框到“ Microsoft Scripting Runtime”并勾选其选中标记

• 点击“确定”