Question

我有以下代码将下面定义的标签中的范围中的所有唯一值复制到“摘要”标签中的单个列：

Sub GetUniqueItems()
    Dim vData As Variant, n&, lLastRow&, sMsg$
    Dim oColl As Collection

    lLastRow = Worksheets(Worksheets("Summary").Range("A1").Value)._
    Cells(Rows.Count, "H").End(xlUp).Row
    If lLastRow = 1 Then Exit Sub

    vData = Worksheets(Worksheets("Summary").Range("A1").Value)._
    Range("H2:H" & lLastRow)
    Set oColl = New Collection
    For n = LBound(vData) To UBound(vData)
        On Error Resume Next
        oColl.Add vData(n, 1), CStr(vData(n, 1))
        On Error GoTo 0
    Next n

    For n = 1 To oColl.Count
        sMsg = oColl(n)
        Sheets("Summary").Cells(n + 3, 1).Value = Mid$(sMsg, 1)
    Next n
End Sub

这适用于定义的范围。我想要做的是从定义的选项卡中的动态范围复制。此范围将由最后一列定义，第1行中包含条目，第A列和最后一列之间最后一行填充。看来，只要我引入lastcol变量，或者包含多列的范围，代码就会出错。

我到目前为止构建的代码是：

Sub GetUniqueItems()
    Dim vData As Variant, n&, lLastRow&, sMsg$
    Dim oColl As Collection

    Dim lastrow As Long
    Dim lLastCol As Long

    'Find last column in Row 1 of each data tab
    lLastCol = Worksheets(Worksheets("Summary").Range("A1").value)._
    Cells(1, Columns.Count).End(xlToLeft).Column

    If lLastCol < 1 Then Exit Sub

    ' Find the last row of the last column
    lLastRow = Worksheets(Worksheets("Summary").Range("A1").value)._
    Cells(Rows.Count, lLastCol).End(xlUp).Row

    If lLastRow = 1 Then Exit Sub

    vData = Worksheets(Worksheets("Summary").Range("A1").value).Range(llastcol)

    Set oColl = New Collection
    For n = LBound(vData) To UBound(vData)
        If Not (IsDate(vData(n, 1)) Or IsEmpty(vData(n, 1))) Then oColl._
    Add (vData(n, 1)), CStr(vData(n, 1))
        On Error GoTo 0
    Next n

    For n = 1 To oColl.Count
        sMsg = oColl(n)

        Sheets("Summary").Cells(n + 3, 1).value = Mid$(sMsg, 1)
        Sheets("Summary").Cells(n + 3, 1).Offset(0, 1).value = _
        Application.CountIf(Worksheets(Range(Split(Sheets("Summary")._
    Cells(n + 3, 1).Address, "$")(1) & "1").value).Cells, Mid$(sMsg, 1))
    Next n

End Sub

有什么建议吗？

Answer 1

我得到的错误归因于.Range(lLastCol)，其中lLastCol是一个整数。

如果要选择包含该索引的列，请改用.Columns(lLastCol)。

我遇到的下一个错误是因为我试图向oColl添加重复项。我使用了与你的第一个样本相同的技巧，所以克服了这一点，并克服了错误。

下一个错误位于最后一行Next n之前的最后一行代码中。可能有一个一个或一个逻辑错误，但我相信你可以从这里拿走它。

我的代码：

Sub GetUniqueItems_Dynamic()
    Dim vData As Variant, n&, lLastRow&, sMsg$
    Dim oColl As Collection

    Dim lastrow As Long
    Dim lLastCol As Long

    'Find last column in Row 1 of each data tab
    lLastCol = Worksheets(Worksheets("Summary").Range("A1").Value). _
    Cells(1, Columns.Count).End(xlToLeft).Column

    If lLastCol < 1 Then Exit Sub

    ' Find the last row of the last column
    lLastRow = Worksheets(Worksheets("Summary").Range("A1").Value). _
    Cells(Rows.Count, lLastCol).End(xlUp).Row

    If lLastRow = 1 Then Exit Sub

    vData = Worksheets(Worksheets("Summary").Range("A1").Value).Columns(lLastCol)

    Set oColl = New Collection
    For n = LBound(vData) To UBound(vData)
        On Error Resume Next
        If Not (IsDate(vData(n, 1)) Or IsEmpty(vData(n, 1))) Then oColl. _
    Add (vData(n, 1)), CStr(vData(n, 1))
        On Error GoTo 0
    Next n

    For n = 1 To oColl.Count
        sMsg = oColl(n)

        Sheets("Summary").Cells(n + 3, 1).Value = Mid$(sMsg, 1)
        Sheets("Summary").Cells(n + 3, 1).Offset(0, 1).Value = _
            Application.CountIf(Worksheets(Range(Split(Sheets("Summary"). _
            Cells(n + 3, 1).Address, "$")(1) & "1").Value).Cells, Mid$(sMsg, 1))
    Next n

End Sub

收集错误中的动态范围

1 个答案: