0

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

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

有什么建议么？

4

1 回答 1

0

我得到的错误是由于.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
于 2013-07-12T18:25:23.617 回答