版权声明: https://blog.csdn.net/qq_27469815/article/details/83576185
Sub crDelReport()
t1 = Timer
Application.ScreenUpdating = False
Call importLog
Call findBrokenStation
Call nowCrReport
Call crFile
Application.ScreenUpdating = True
t2 = Timer
Debug.Print "运行时间 = " & (t2 - t1) * 1000 & " ms"
End Sub
Sub crFile()
Worksheets("结果统计-删除").Copy
With ActiveSheet
.Select
.Columns("A:E").Delete
.Shapes.Range(Array("Picture 1")).Delete
[G1] = "执行结果"
[G2] = "断站"
[G3] = "执行成功"
[G4] = "总计"
[H1] = "数量"
[H2].formula = "=COUNTIF(E:E,G2)"
[H3].formula = "=COUNTIF(E:E,G3)"
[H4].formula = "=SUM(H2:H3)"
End With
' 格式化
Call formatting
ActiveWorkbook.SaveAs "XXXX测量配置结果_" & Month(Date) & "月第四组.xlsx"
End Sub
Sub nowCrReport()
Application.ScreenUpdating = False
Dim d As Object, rng As Range
Set dCity = CreateObject("Scripting.Dictionary")
Set dOSS = CreateObject("Scripting.Dictionary")
With Worksheets("ip对应地市名工具")
For i = 1 To .[A65536].End(xlUp).Row
dCity.add .Cells(i, 1).Value, .Cells(i, 2).Value
dOSS.add .Cells(i, 1).Value, .Cells(i, 3).Value
Next
End With
Dim lRow%, leftIp$
lRow = [A65536].End(xlUp).Row
' 地市 OSS归属 IP 网元名 删除异频结果
On Error Resume Next
For i = 2 To lRow
If Cells(i, 1).Value <> "" Then
leftIp = Left(Cells(i, 1).Value, 6)
Cells(i, 6).formula = dCity(leftIp)
Cells(i, 7).formula = dOSS(leftIp)
Cells(i, 8) = Cells(i, 1)
Cells(i, 9) = Cells(i, 2)
Cells(i, 10) = IIf(Cells(i, 4) = "", "断站", "执行成功")
End If
Next
'此处妙,多重功能:删除A列空行,不正确IP,8.137站点
Columns("F:F").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
' 格式化
Application.ScreenUpdating = True
End Sub
Sub findBrokenStation()
Dim arr, brr, crr, lRow%, lRow2%
lRow = [A65535].End(xlUp).Row
arr = WorksheetFunction.Transpose(Range("A2:A" & lRow & "").Value) '删除的IP列
With Worksheets("全合并-找断站")
lRow2 = .[A65535].End(xlUp).Row
brr = WorksheetFunction.Transpose(.Range("D2:D" & lRow2 & "").Value) '全合并-找断站的D列基站IP
crr = WorksheetFunction.Transpose(.Range("A2:A" & lRow2 & "").Value) '全合并-找断站的A列基站名称
End With
Dim ip(2000, 1 To 1), eNodeB(2000, 1 To 1)
j = 0
For i = 1 To UBound(brr)
If UBound(Filter(arr, brr(i))) = -1 Then
ip(j, 1) = brr(i)
eNodeB(j, 1) = crr(i)
j = j + 1
End If
Next
lRow = [A65536].End(xlUp).Row + 1
Dim iUb%
iUb = UBound(ip)
Range(Cells(lRow, 1), Cells(lRow + iUb, 1)) = ip
Range(Cells(lRow, 2), Cells(lRow + iUb, 2)) = eNodeB
'除重
ActiveSheet.Range("$A$1:$E$65536").RemoveDuplicates Columns:=1, Header:=xlYes
End Sub
Sub importLog()
'选择路径
Dim arr, brr, crr
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
If fd.Show <> -1 Then '不等于-1表示没有选取任何文件
Set fd = Nothing
Exit Sub
End If
' 清除原数据
lRow = [A65536].End(xlUp).Row
If lRow > 1 Then Rows("2:" & lRow).Delete
For Each a In fd.SelectedItems
If Right(a, 4) = ".log" Then
Open a For Input As #1
arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbLf)
Close #1
aUb = UBound(arr)
ReDim crr(aUb, 4)
For i = 0 To aUb
brr = Split(arr(i), ",")
For j = 0 To UBound(brr)
crr(i, j) = brr(j)
Next
Next
lRow = [A65536].End(xlUp).Row + 1
Range(Cells(lRow, 1), Cells(lRow + aUb, 5)) = crr
End If
Next
Set fd = Nothing
End Sub
Sub formatting()
' 置中,加边框,上色
Range("G1:H4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("G1:H1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("G4:H4").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Rows("2:3").Select
Selection.RowHeight = 21
Range("G3").Select
End Sub