Question

我有一个“ PointsTally”工作表，其中包含名称列表。

在工作表“ LOG”中，我正在尝试

匹配（遍历）“ 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

查找列表中的前三个事件

1 个答案: