VBA调试代码

可爱小喵喵

Sub 数据2()
    Application.ScreenUpdating = False '关闭屏幕刷新
    Application.DisplayAlerts = False '关闭弹窗
    Dim str As Variant
    Dim d As Object, arr, brr, crr, drr, err, frr, hrr, dl, dll, dlll, dllll, dlllll, i&, s, m, h
    Dim wb As Workbook
    crr = Sheets("4G后台数据").[a1].CurrentRegion
    '获取4G后台数据F行号
    m = Sheets("4G后台数据").Range("F" & Rows.Count).End(xlUp).Row
    Set d = CreateObject("scripting.dictionary") '字典
    Set dl = CreateObject("scripting.dictionary") '字典
    Set dll = CreateObject("scripting.dictionary") '字典
    Set dlll = CreateObject("scripting.dictionary") '字典
    Set dllll = CreateObject("scripting.dictionary") '字典
    Set dlllll = CreateObject("scripting.dictionary") '字典
    Filename = Application.GetOpenFilename(filefilter:="Excel工作簿文件,*.xlsx;*")
    If Filename = False Then
        MsgBox "没有选择任何文件"
        Exit Sub
        Else
    Set wb = Workbooks.Open(Filename) '打开数据源
    End If
    Set zb = ThisWorkbook.Sheets("4G后台数据")
    'Set wb = Workbooks.Open(ThisWorkbook.Path filefilterfilefilter& "\数据源.xlsx") '打开数据源
    i = wb.Sheets("查询小区静态参数").Range("F" & Rows.Count).End(xlUp).Row 'F列行号
    '这两列复制和后面crr输出是两部分输出的，怎么放到一起一次输出啊
    wb.Sheets("查询小区静态参数").Range("B2:B" & i).Copy zb.Range("D" & m + 1)  '复制查询小区静态参数B列到4G后台数据C列最后一个有数据的
    wb.Sheets("查询小区静态参数").Range("F2:F" & i).Copy zb.Range("F" & m + 1)  '复制查询小区静态参数F列到4G后台数据E列最后一个有数据的
    arr = wb.Sheets("查询小区静态参数").[a1].CurrentRegion
    '多条件查询:查询小区静态参数
    For i = 2 To UBound(arr)
        d(arr(i, 2) & arr(i, 6)) = Array(arr(i, 1), arr(i, 5), arr(i, 15), arr(i, 16), arr(i, 17), arr(i, 18), arr(i, 19), arr(i, 24))
    Next
    '单条件查询:查询eNodeB功能配置
    brr = wb.Sheets("查询eNodeB功能配置").[a1].CurrentRegion
    For i = 2 To UBound(brr)
        dl(brr(i, 2)) = brr(i, 7)
    Next
    '查询小区动态参数
    frr = wb.Sheets("查询小区动态参数").[a1].CurrentRegion
    For i = 2 To UBound(frr)
        dll(frr(i, 2) & frr(i, 5)) = frr(i, 7)
    Next
    '查询小区运营商信息
    err = wb.Sheets("查询小区运营商信息").[a1].CurrentRegion
    For i = 2 To UBound(err)
        dlll(err(i, 2) & err(i, 5)) = err(i, 6)
    Next
    '查询gNodeB跟踪区域信息
    drr = wb.Sheets("查看跟踪区域配置信息").[a1].CurrentRegion
    For i = 2 To UBound(drr)
        dllll(drr(i, 2) & drr(i, 5)) = drr(i, 7)
    Next
    hrr = wb.Sheets("License配置信息").[a1].CurrentRegion
    For i = 2 To UBound(hrr)
        dlllll(hrr(i, 2) & hrr(i, 9)) = hrr(i, 4)
    Next
    wb.Close False
    '单条件查询加取值前五位字符
    For i = 2 To UBound(crr)
        If d.exists(crr(i, 4) & crr(i, 6)) Then
            s = d(crr(i, 4) & crr(i, 6))
            crr(i, 1) = Left(s(0), 5) '所属网管
            crr(i, 5) = s(1) '本地小区标识
            crr(i, 7) = s(2) '下行频点
            crr(i, 8) = s(3) '上行带宽
            crr(i, 9) = s(4) '下行带宽
            crr(i, 10) = s(5) '小区标识
            crr(i, 11) = s(6) '物理小区标识
            crr(i, 13) = "4G与5G互操作(" & s(7) & ")"
        End If
        If dl.exists(crr(i, 4)) Then
            crr(i, 2) = dl(crr(i, 4)) 'eNodeB标识
        End If
        If dll.exists(crr(i, 4) & crr(i, 5)) Then
            crr(i, 12) = dll(crr(i, 4) & crr(i, 5)) 'NR DU小区状态说明
        End If
        If dllll.exists(crr(i, 4) & dlll(crr(i, 4) & crr(i, 5))) Then
            crr(i, 3) = dllll(crr(i, 4) & dlll(crr(i, 4) & crr(i, 5))) 'TAC
        End If
        If dlllll.exists(crr(i, 4) & crr(i, 13)) Then
            crr(i, 13) = dlllll(crr(i, 4) & crr(i, 13)) 'eNodeB标识
            If dlllll(crr(i, 4) & crr(i, 13)) = 执行成功 Then
               crr(i, 13) = "是"
            Else
                crr(i, 13) = "否"
            End If
        End If
    Next
    [a1].Resize(UBound(crr), 14) = crr
    Set d = Nothing
    Set dl = Nothing
    Set dll = Nothing
    Set dll = Nothing
    Set dlll = Nothing
    Set dllll = Nothing
    Set dlllll = Nothing
    '规范格式
    Cells.Select
    Cells.Font.Name = "等线"
    Cells.Font.Size = 10
    With Cells.Borders(xlEdgeLeft)
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    With Cells.Borders(xlEdgeTop)
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    With Cells.Borders(xlEdgeBottom)
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    With Cells.Borders(xlEdgeRight)
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    With Cells.Borders(xlInsideVertical)
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    With Cells.Borders(xlInsideHorizontal)
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    Cells.Borders(xlEdgeLeft).ColorIndex = xlColorIndexAutomatic
    Cells.Borders(xlEdgeTop).ColorIndex = xlColorIndexAutomatic
    Cells.Borders(xlEdgeBottom).ColorIndex = xlColorIndexAutomatic
    Cells.Borders(xlEdgeRight).ColorIndex = xlColorIndexAutomatic
    Cells.Borders(xlInsideVertical).ColorIndex = xlColorIndexAutomatic
    Cells.Borders(xlInsideHorizontal).ColorIndex = xlColorIndexAutomatic
    Application.DisplayAlerts = True '打开弹窗
    Application.ScreenUpdating = True '打开屏幕刷新
End Sub

psxk3535

修改还不如重写

xunanming

参考---------------------------------