Найти дубликаты в столбце с переменным диапазоном и количество в отдельном столбце

Question

Я пытаюсь определить любые дубликаты в столбце, который является переменным диапазоном. Я нашел этот код:

Public Sub assignSeq()

targetRng = "A2:A14" 'Define the Range you want to assign number

For Each Rng In Range(targetRng)

Rng.Offset(0, 1).Value = 

Application.WorksheetFunction.CountIf(Range(Split(targetRng, ":")(0) & ":" & Rng.Address), Rng.Value)

Next

End Sub

Я попытался изменить его, надеясь, что смогу использовать его для столбца, который будет иметь переменный диапазон (я буду использовать этот код вместе с другим кодом во многих книгах, поэтому не могу иметь его с заданным диапазоном т.е. E2: E15).

Sub assignSeq()

Dim lastRow As Long

Dim targetRng As Range

Dim rng As Range

'Column E won't be the same length every file that this macro is ran in. Column B is used to tell how long column E is.

lastRow = Cells(Rows.Count, "B").End(xlUp).Row

'Define the Range you want to assign number

Set targetRng = Range("E2:E5" & lastRow)

Set rng = Range("E2:E5" & lastRow)

 For Each rng In Range("E2:E5" & lastRow)
 rng.Offset(0, 1).Value = 

Application.WorksheetFunction.CountIf(Range(Split(targetRng, ":")(0) & ":" & rng.Address), rng.Value)

 Next

End Sub

Когда я запускаю код, я получаю сообщение об ошибке «13»: несоответствие типов.

Ниже, Столбец F - это то, что я хочу, чтобы этот код выполнял до самого столбца независимо от его длины. Столбец G написан в отдельном коде, который я написал и работает, поэтому я не обязательно ищу помощь в этом, а скорее хочу показать, чего я в конечном итоге пытаюсь достичь.

Column E           Column F     Column G  

PermAssetNumber    Count        PermAssetNumber w/Count
B02061               1          B02061
B02061               2          B02061_2
B02079               1          B02079
B02081               1          B02081
B02081               2          B02081_2
B02063               1          B02063
B02070               1          B02070
B02062               1          B02062
B02081               3          B02081_3
B02086               1          B02086
B02087               1          B02087
B02088               1          B02088
B02089               1          B02089
B02090               1          B02090
B02091               1          B02091
B02065               1          B02065
B02082               1          B02082
B02083               1          B02083
B02048               1          B02048
B02081               4          B02081_4

Answer 1

Каждый раз, когда задействованы дубликаты, я использую dictionary object.Словарь представляет собой расширенный hashtable, который допускает только уникальные пары ключ-значение.Ниже приведен пример, который вы можете изменить в соответствии со своими потребностями.

Option Explicit

Public Sub RunningCounts(ByVal strWBName As String, ByVal strWSName As String, _
                         ByVal strTargteRngAddress As String, ByVal strColToFindLR As String)

 Dim objDict As Object
 Dim objWB As Workbook
 Dim objWS As Worksheet
 Dim rngToLookUp As Range
 Dim lngLastRow As Long, i As Long
 Dim arrySheet As Variant, arryOut() As Variant
 Dim varKey As Variant

    Set objWB = Workbooks(strWBName)
    Set objWS = objWB.Worksheets(strWSName)
    lngLastRow = objWS.Cells(objWS.Rows.Count, strColToFindLR).End(xlUp).Row
    Set rngToLookUp = objWS.Range(strTargteRngAddress & lngLastRow)

    If rngToLookUp.Columns.Count > 1 Then
        MsgBox "The input Range cannot be more than" _
        & " a single column.", vbCritical + vbOKOnly, "Error:" _
        & " Invalid Range Dimensions"
        Exit Sub
    End If

    arrySheet = rngToLookUp.Value2

        ReDim arryOut(1 To UBound(arrySheet, 1), 1 To 1)

        Set objDict = CreateObject("Scripting.Dictionary")

            For i = LBound(arrySheet, 1) To UBound(arrySheet, 1)
                'each time a key occurs, add one to the item associated with that key
               varKey = Trim(arrySheet(i, 1))
               If Not objDict.Exists(varKey) Then
                  objDict(varKey) = 1
                  arryOut(i,1) = 1
               Else
                  objDict(varKey) = objDict(varKey) + 1  
                  arryOut(i,1) = objDict.Item(varKey)             
               End If
               varKey = Empty 
            Next i

    rngToLookUp.Offset(0, 1).Resize(UBound(arryOut, 1), _
    UBound(arryOut, 2)).Value2 = arryOut

End Sub


Public Sub ExecuteRunningCount()

 Dim strTgtWBName As String
 Dim strgtWSName As String
 Dim strTgtRangeAddress As String
 Dim strTgtColToLookInLR As String

    strTgtWBName = "SomeWBNamew.xlsm" 
    strTgtWSName = "SheetName"
    strTgtRangeAddress = "A2:A"
    strTgtColToLookInLR = "A"

    Call RunningCounts(strTgtWBName, strTgtWSName, strTgtRangeAddress, strTgtColToLookInLR )

End Sub

Answer 2

Попробуйте это.

• У вас были некоторые опечатки Range("E2:E5" & lastRow) - ошибка 5:

• Split(targetRng, ":") неверно, потому что Targetrng это диапазонне строка, поэтому мы используем ее свойство Address, которое является строкой.

  Sub assignSeq()
  
  Dim lastRow As Long
  Dim targetRng As Range
  Dim rng As Range
  
  lastRow = Cells(Rows.Count, "B").End(xlUp).Row
  
  Set targetRng = Range("E2:E" & lastRow)
  
  For Each rng In targetRng
      rng.Offset(0, 1).Value = _
          Application.WorksheetFunction.CountIf(Range(Split(targetRng.Address, ":")(0) & ":" & rng.Address), rng.Value)
  Next
  
  End Sub