동적 범위

Question

I 아래 정의 "요약"탭에 하나의 컬럼 탭의 범위에서 모든 고유 값을 복사하려면 다음 코드가 있습니다

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