遍历姓名列表，如果选择中存在姓名，则从姓氏开始

Question

抱歉，这是我第一次破解 Excel VBA，请原谅我缺乏知识！

所以我有一个（当前）3 个名称的列表，以在 Excel 中以重复顺序分配给 A 列中的日期。

目前我的 VBA 代码允许它使用重复模式的名称填充选定的单元格（这部分很好），但是有两部分我需要帮助。

1- 使用当前代码，一旦到达名称的底部，它会检查将结束该列表并按照指示从顶部重新开始的空白框，但它会首先放置一个空白单元格（参见屏幕截图）。如何在不先添加空白单元格的情况下输入下一个名称？

2- 我希望能够（一旦开始）通过需要填写的日期选择整个 D 列，并且：

-检查最低的非空白框

-匹配列表并设置
与下面的名字相反，所以 它继续名称顺序 从最后一个人 分配

这是我现在拥有的代码：

Sub EXAMPLE()
Dim count As Integer
count = 0
For Each c In Selection
    c.Value = Range("X1").Offset(count, 0).Value
    If c.Value = "" Then count = -1 And c.Value = Range("x1").Offset(count, 0).Value
    count = count + 1
Next c
End Sub

对不起，我知道这很长，我希望这是有道理的。

Answer 1

我认为有关数组的内容值得一读，因为这项任务非常适合它们的使用。您最好的选择是将名称读入一个数组，然后构建一个循环数组，其维度等于日期列中的行数（或选择，或者您想要定义输出范围的大小）。

代码看起来有点像这样：

Dim v As Variant
Dim people() As Variant, output() As Variant
Dim rowCount As Long, i As Long, j As Long
Dim endRange As Range

'Read the list of names into an array.
'This just takes all data in column "X" -> amend as desired
With Sheet1
    Set endRange = .Cells(.Rows.Count, "X").End(xlUp)
    v = .Range(.Cells(1, "X"), endRange).Value
End With

'Sense check on the names data.
If IsEmpty(v) Then
    MsgBox "No names in Column ""X"""
    Exit Sub
End If

If Not IsArray(v) Then
    ReDim people(1 To 1, 1 To 1)
    people(1, 1) = v
Else
    people = v
End If

'Acquire the number of rows for repeating list of names.
'This just takes all data in column "A" -> amend as desired
With Sheet1
    Set endRange = .Cells(.Rows.Count, "A").End(xlUp)
    rowCount = .Range(.Cells(3, "A"), endRange).Rows.Count
End With

'Sense check date data.
If endRange.Row < 3 Then
    MsgBox "No dates in Column ""A"""
    Exit Sub
End If

'Make a recurring array.
ReDim output(1 To rowCount, 1 To 1)
i = 1
Do While i <= rowCount
    For j = 1 To UBound(people, 1)
        output(i, 1) = people(j, 1)
        i = i + 1
        If i > rowCount Then Exit Do
    Next
Loop

'Write the output to column "D"
Sheet1.Range("D3").Resize(UBound(output, 1)).Value = output