VBA 循环单元格查询示例

最新推荐文章于 2024-10-28 10:09:45 发布

志大洋

最新推荐文章于 2024-10-28 10:09:45 发布

阅读量1.8k

点赞数 2

文章标签： vba

本文链接：https://blog.csdn.net/wzg725/article/details/121117652

版权

辅助工具专栏收录该内容

4 篇文章

订阅专栏

本文介绍了一种使用VBA在Excel中实现的功能，该功能能够根据IP地址查找对应的服务及应用信息，并进行有效性验证。通过定义函数FindServiceByIP()来搜索特定工作表(meta)内的IP地址，进而获取其关联的服务详情。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

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