如何根据 VBA 中命名的开始和结束单元格选择一系列单元格？

Question

我通过将 MySQL 数据库中的数据保存为 csv 并将该 csv 数据粘贴到工作表中来将数据提取到工作表中。此 csv 包含所有客户端的所有数据，由标记单元格分隔，如下所示：“Client1:START”和“Client1:END”。然后我正在运行一个复制两个页面的宏：一个包含来自聚合表的单个客户的数据，另一个包含运行该数据的图表。

我几乎完成了所有工作：复制所有页面并更新图表中的引用以及从该客户的数据表中提取信息的单元格。

剩下要做的就是将汇总表中的数据复制到每个客户的表中。我想了很多，这似乎是最简单的方法，因为我不知道将为给定客户端生成的行数（零到 31 之间的任何值，因为这是每月报告），就是在该客户端的第一行之前的行的第一个单元格中包含“Client1:START”，在之后的行的第一个单元格中包含“Client1:END”。

然后我可以简单地搜索单元格，直到找到这两个，命名它们（因为我还不知道如何将单元格地址保存在变量中），然后以某种方式偏移它们以获得我的实际范围想要，减去标记。

然后我可以复制该范围并将其粘贴到新创建的数据表中。

实际上，我什至还没有达到抵消的程度。我仍在挣扎尝试根据它们的名称选择单元格。这就是我所拥有的：

Dim Client
Dim SelectedCell
Dim StartCell
Dim EndCell

For Each Client In Array("Client1", "Client2")

    StartCell = Client & "StartCell"
    EndCell = Client & "EndCell"

    Sheets("ALL-DATA").Select
    For Each SelectedCell In Range("A1:D20")
        If SelectedCell.Value = Client & ":START" Then
            SelectedCell.Name = StartCell
        End If
        If SelectedCell.Value = Client & ":END" Then
            SelectedCell.Name = EndCell
        End If
    Next SelectedCell

    Range(StartCell & ":" & EndCell).Select  '<-- This won't compile
Next Client

那个范围不允许我使用变量进行选择，所以我有点卡住了。 VBA 似乎只允许您使用地址字符串选择范围。

如果有人能指出我正确的方向，将不胜感激。而且，如果您知道我可以如何调整选择以排除实际标记（考虑到数据长度为零的可能性），那将是非常棒的和巨大的奖励。

谢谢！

Answer 1

由于我在上面的 cmets 中提到的多种原因，此代码无法编译。我相信下面的方法会起作用。您应该养成始终声明变量并使用 Option Explicit 来防止拼写错误等的习惯。

• 您需要一种方法来获取单元格的地址，即通过引用它的.Address 属性:) 单元格和范围没有.Name 属性，因此您的代码实际上会在SelectedCell.Name = StartCell 行上失败
• 您的赋值语句是倒退的。为了将StartCell 变量赋值给到，该变量必须在赋值语句的左边，并且如果它需要表示一个对象 em> 像一个单元格/范围，那么您还必须使用Set 关键字，即Set StartCell = Range("A1")。

我也将此更新为avoid any use of Select method。在 Excel 中，99.9% 的时间都不需要 Select 或 Activate。

Dim Client as Variant
Dim SelectedCell as Range
Dim StartCell as Range
Dim EndCell as Range
Dim ClientRange as Range

For Each Client In Array("Client1", "Client2")

    For Each SelectedCell In Sheets("ALL-DATA").Select.Range("A1:D20")
        If SelectedCell.Value = Client & ":START" Then
            Set StartCell = SelectedCell
        ElseIf SelectedCell.Value = Client & ":END" Then
            Set EndCell = SelectedCell
        End If
    Next SelectedCell

    Set ClientRange = Sheets("ALL-DATA").Range(StartCell.Address & ":" & EndCell.Address)
Next Client

现在您已将ClientRange 认定为属于“所有数据”工作表，通常无需出于任何原因选择或激活它。这样做只会给代码增加不必要的操作和复杂性，并降低其性能。

Answer 2

如果行包含特定于客户端的单元格，则使用自动过滤器仅显示这些行。然后执行全选（记录）。

针对您的具体问题。

找到我记录的你的单元格（工具 - 宏 - 记录新宏）编辑 - 查找

Cells.Find(What:="fred", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
    xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=False).Activate

你可以把它改成

Set client = Cells.Find(What:="fred", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
    xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=False)

Answer 3

我处理这个功能的数量。

1) 获取表格开头和结尾的引用：

使用 Application.Range 或 Me.Range 查找由命名范围标识的表的开始和结束。在这种情况下，表格有一个标题和一个脚行来标记表格的开始和结束。

我将这些函数保存在工作表的模块中，这样我就可以使用 Me.Range。我还使用将命名范围的范围限制为仅工作表。

Private Function GetTableStart() As Long
    GetTableStart = Me.Range("TABLE_START").Row + 1
End Function

Private Function GetTableEnd() As Long
    GetTableEnd = Me.Range("TABLE_END").Row - 1
End Function

我还命名了列，COLUMN_ID 是一个命名范围，用于选择工作表中的整个列。例如，它的命名范围是“工作表”！$A:$A

Private Function GetColumnId() As Long
    GetColumnId = Me.Range("COLUMN_ID").Column
End Function

Private Function GetLastColumn() As Long
    GetLastColumn = Me.Range("COLUMN_LAST").Column
End Function

2) 更改表格的大小。给它你想要的行数，它会为你调整表格的大小。 ：

Private Sub FixTableSize(expectedRows As Long)

    If expectedRows = 0 Then
        Err.Raise vbObjectError + 513, Me.name, "Cannot resize the table's number of rows to 0"
    End If

    Dim startRow As Long
    Dim endRow As Long
    Dim startColumn As Long
    Dim endColumn As Long
    Dim numberOfRows As Long
    Dim table As Range

    startRow = GetTableStart()
    endRow = GetTableEnd()
    startColumn = GetColumnId()
    endColumn = GetColumnEnd()

    numberOfRows = endRow - startRow + 1
    Set table = Me.Range(Me.Cells(startRow, startColumn), Me.Cells(endRow, endColumn))

    If numberOfRows > 0 Then
        ' Prevent it from clearing the headers
        table.ClearContents
    End If

    With Me
        Dim cnt As Integer
        If expectedRows > numberOfRows Then
            For cnt = 1 To (expectedRows - numberOfRows)
                table.Rows(2).Insert xlShiftDown
            Next cnt
        ElseIf expectedRows < numberOfRows Then
            For cnt = 1 To (numberOfRows - expectedRows)
                table.Rows(1).Delete xlShiftUp
            Next cnt
        End If
    End With

End Sub

3) 填充表格。一旦表格的大小合适，我就会用我想要的数据填充表格。

Private Sub PopulateIssues(sprints() As JIRASprint)
    Dim currentSprint As Variant
    Dim currentRow As Long

    currentRow = GetTableStart()
    For Each currentSprint In sprints
        Me.Cells(currentRow, GetColumnId()).Value = currentSprint.Id
        Me.Cells(currentRow, GetColumnName()).Value = currentSprint.name
        Me.Cells(currentRow, GetColumnClosed()).Value = currentSprint.Closed
        Me.Cells(currentRow, GetColumnStartDate()).Value = currentSprint.startDate
        Me.Cells(currentRow, GetColumnEnd()).Value = currentSprint.endDate

        If currentSprint.completeDate <> 0 Then
            Me.Cells(currentRow, GetColumnCompleteDate()).Value = currentSprint.completeDate
        End If

        currentRow = currentRow + 1
    Next

End Sub

4) 然后我将它们与一个称为更新表的子程序放在一起。

Private Sub UpdateTable()
On Error GoTo ErrHandler

    Dim numberOfRows As Long
    Dim sprints() As JIRASprint ' Where JIRASprint is a custom Class I made.

    numberOfRows = ... ' Find out how many rows I need somehow.
    Set sprints = GetData() '  Get the data however you want.


    ' turn these off so it updates faster ...
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    FixTableSize numberOfRows
    PopulateIssues sprints

    ' turn them back on ...
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

Exit Sub

ErrHandler:
    ' turn them back on ...
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox "An error occured while updating the worksheet"

End Sub

希望这会有所帮助！