动态范围

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