在Excel中计算变量范围内的行



我在Excel VBA中建立了一个偏离数据集中两个值位置的范围。范围内开始和停止的行号将随着数据输入而变化,因此我需要创建一个始终偏离设定区域的范围。我现在需要计算范围内的行数/值,以便一旦我复制了该范围内的数据,我就可以在不更改原始列表的情况下删除重复项。如何计算范围内的行数?

我尝试使用copyrange.Rows.Count但收到错误 438

Sub count_ID_List()
    Set botrow = Cells.Find("Stud ID")
    'Finds the first row of the count section of the invitory'
    Set toprow = Cells.Find("Stud Part Number")
    'Finds the top row of the company invintory'
    Set copyrange = Range(toprow.Offset(1, 0).Address, botrow.Offset(-12, 1).Address)
    Set copyto = Range(botrow.Offset(1, 0), botrow.Offset(1, 0))
    copyrange.Copy (copyto)
    'this is where i would like to then remove duplicates from the newly copied data'
End Sub

使用 Range.Find 方法后,您始终需要测试是否找到了某些内容:

Set BotRow = Cells.Find("Stud ID")
If BotRow Is Nothing Then
    MsgBox "Stud ID was not found!"
    Exit Sub
End If
  • 始终在 find 方法中定义 LookAt 参数,否则 Excel 将使用以前使用的任何参数(由用户或 VBA(。
  • 为所有CellsRange对象指定它们所在的工作表。
  • 使用 Option Explicit 并正确声明所有变量。

以下方法应该有效:

Option Explicit
Public Sub count_ID_List()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1") 'define your sheet name here
    'Finds the first row of the count section of the invitory'
    Dim BotRow As Range
    Set BotRow = ws.Cells.Find(What:="Stud ID", LookAt:=xlWhole)
    If BotRow Is Nothing Then
        MsgBox "'Stud ID' was not found!"
        Exit Sub
    End If
    'Finds the top row of the company invintory'
    Dim TopRow As Range
    Set TopRow = ws.Cells.Find(What:="Stud Part Number", LookAt:=xlWhole)
    If TopRow Is Nothing Then
        MsgBox "'Stud Part Number' was not found!"
        Exit Sub
    End If
    Dim CopyRange As Range
    Set CopyRange = ws.Range(TopRow.Offset(1, 0), BotRow.Offset(-12, 1))
    Dim CopyTo As Range
    Set CopyTo = BotRow.Offset(1, 0)
    'output row count
    Debug.Print CopyRange.Rows.Count
    CopyRange.Copy Destination:=CopyTo
    'this is where i would like to then remove duplicates from the newly copied data'
    CopyTo.Resize(RowSize:=CopyRange.Rows.Count).RemoveDuplicates Columns:=Array(1), Header:=xlNo
End Sub

最新更新