Найти первые три вхождения в списке

Question

У меня есть лист "PointsTally" со списком имен.

В рабочем листе "ЛОГ" я пытаюсь

• сопоставить (перебрать) все имена в списке "PointsTally"
• найти первые три совпадения каждого имени в «LOG»
• и напишите что-нибудь в другой столбец в «ЖУРНАЛЕ».

Следующий код - это то, что я придумал, но он, кажется, помещает «Да» в каждую ячейку в столбце, поэтому мой цикл не работает.

Sub loopnsub()

    Call sortlog  'Sortlog is a sub that sorts that sheet by descending date.

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim name As Range
    Dim x As Long
    Dim iCol As Integer
    Dim iCol2 As Integer
    Dim i

    iCol = 2
    iCol2 = 7

    Set ws1 = Sheets("PointsTally")
    Set ws2 = Sheets("LOG")

    For Each name In ws1.UsedRange.Columns("B").Cells      
        For x = Cells(Cells.Rows.Count, iCol).End(xlUp).Row To 2 Step -1 
            For i = 1 To 3

                If Cells(x, iCol).Value = name.Value Then
                    Cells(x, iCol2).Value = "Yes"
                End If

            Next i            
        Next     
    Next c

End Sub

Answer 1

Не уверен, что вы пытаетесь сделать с For i = 1 To 3, просто переписываете в одну и ту же ячейку 3 раза, поэтому я исключил это.

Посмотрите, поможет ли это:

Sub loopnsub()
    Call sortlog

    Const iCol As Integer = 2
    Const iCol2 As Integer = 7

    Dim wsPT As Worksheet: Set wsPT = Sheets("PointsTally")
    Dim wsLOG As Worksheet: Set wsLOG = Sheets("LOG")

    Dim lRowPT As Long: lRowPT = wsPT.Cells(Rows.Count, 2).End(xlUp).Row 'get last row in column B of "PointsTally"
    Dim lRowLOG As Long: lRowLOG = wsLOG.Cells(Rows.Count, iCol).End(xlUp).Row 'get last row in column [iCol] of "LOG"

    Dim Rpt As Long, Rlg As Long, C As Long, X As Long

    For Rpt = 1 To lRowPT 'for each row in "PointsTally"
        X = 0
        For Rlg = 2 To lRowLOG 'for each row in "LOG"
            If wsLOG.Cells(Rlg, iCol).Value = wsPT.Cells(Rpt, 2) Then
                wsLOG.Cells(Rlg, iCol2).Value = "Yes"
                X = X + 1
                If X = 3 Then Exit For 'check next row
            End If
        Next Rlg
    Next Rpt
End Sub