VBA 循环单元格查询示例

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

'
'从meta区域查找IP对应的行，包含但不限于应用/模块
'
Function FindServiceByIP(ip As Variant) As Long

    Dim Cell As Range, Rng As Range
    Dim endRow As Long
    endRow = Worksheets("meta").Range("B" & Rows.Count).End(xlUp).Row

    Set Rng = Worksheets("meta").Range("D4:D" & Worksheets("meta").Range("D" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng ' D列 ip列
        With Cell
            If InStr(CStr(.Value2), CStr(ip)) > 0 Then
                FindServiceByIP = Cell.Row
                Exit Function
            End If
        End With
    Next Cell
    FindServiceByIP = 0
End Function


Sub DoSetService()
    On Error Resume Next
    
    Dim IPCell As Range
    Dim endRow As Long
    Dim metaRow As Long
    Dim MoudApp As String
    
    Sheets("访问日志统计").Activate
    endRow = Worksheets("访问日志统计").Range("G" & Rows.Count).End(xlUp).Row
    If endRow < 1 Then Exit Sub

    Application.ScreenUpdating = False
    For Each IPCell In Range("G2:G" & endRow)
        MoudApp = ""
        With IPCell
            metaRow = FindServiceByIP(.Value)
            If metaRow > 0 Then
                MoudApp = Worksheets("meta").Range("B" & metaRow).Value2 & "/" & Worksheets("meta").Range("C" & metaRow).Value2
                Range("I" & IPCell.Row).Value = MoudApp 'I列设置为根据IP查询得到的邮乐资产里的模块/应用
            End If
            '比较邮乐资产的模块应用 与 接口调用时传递的自定义模块应用
            If StrComp(MoudApp, Range("E" & IPCell.Row).Value, 1) <> 0 Then
                Range("J" & IPCell.Row).Value = "×"
            Else
                Range("J" & IPCell.Row).Value = "○"
            End If
            
        End With
    Next IPCell

    Application.ScreenUpdating = True
End Sub