如何根据VBA中指定的开始和结束单元格选择一系列单元格?

时间:2014-08-06 02:11:52

标签: mysql excel vba excel-vba csv

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

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

唯一要做的就是将汇总工作表中的数据复制到每个客户的工作表中。考虑到我不知道将为给定客户端生成的行数(0到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只允许您使用一串地址选择范围。

如果有人能指出我正确的方向,我将不胜感激。如果你知道如何调整选择以排除实际标记(考虑到数据长度为零行的可能性),这将是非常棒的,并且是一个巨大的奖金。

谢谢!

3 个答案:

答案 0 :(得分:2)

如果行包含特定于客户端的单元格,则使用自动过滤器仅显示这些行。然后选择全部(记录)。

针对您的具体问题。

找到我录制的单元格(工具 - 宏 - 录制新宏)编辑-Find

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)

答案 1 :(得分:2)

由于我在上面的评论中提到的一些原因,此代码无法编译。我相信下面这个会有用。您应该习惯于始终声明您的变量并使用Option Explicit来防止拼写错误/等。

  • 您需要一种方法来获取单元格的地址,这是通过引用它的.Address属性:)单元格和范围没有.Name属性,因此您的代码实际上会在SelectedCell.Name = StartCell
  • 行上失败
  • 您的作业陈述是倒退的。为了使 StartCell变量,该变量必须位于赋值语句的左侧,,如果它需要表示对象就像单元格/范围一样,您还必须使用Set关键字,即Set StartCell = Range("A1")

我还将其更新为avoid any use of Select method。在Excel中,SelectActivate任何内容都不需要99.9%的时间。

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限定为属于&#34; All-DATA&#34;工作表,通常无需出于任何原因选择或激活它。这样做只会给代码增加不必要的操作和复杂性,并降低其性能。

答案 2 :(得分:0)

我在功能的数量上处理这个问题。

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

希望这有帮助!