【VBA】【一天的心血，收藏一下】一键生成报表


Sub crDelReport()t1 &＃61; TimerApplication.ScreenUpdating &＃61; FalseCall importLogCall findBrokenStationCall nowCrReportCall crFileApplication.ScreenUpdating &＃61; Truet2 &＃61; TimerDebug.Print "运行时间 &＃61; " & (t2 - t1) * 1000 & " ms"End Sub
Sub crFile()Worksheets("结果统计-删除").CopyWith ActiveSheet.Select.Columns("A:E").Delete.Shapes.Range(Array("Picture 1")).Delete[G1] &＃61; "执行结果"[G2] &＃61; "断站"[G3] &＃61; "执行成功"[G4] &＃61; "总计"[H1] &＃61; "数量"[H2].formula &＃61; "&＃61;COUNTIF(E:E,G2)"[H3].formula &＃61; "&＃61;COUNTIF(E:E,G3)"[H4].formula &＃61; "&＃61;SUM(H2:H3)"End With
&＃39; 格式化Call formattingActiveWorkbook.SaveAs "XXXX测量配置结果_" & Month(Date) & "月第四组.xlsx"End SubSub nowCrReport()
Application.ScreenUpdating &＃61; FalseDim d As Object, rng As RangeSet dCity &＃61; CreateObject("Scripting.Dictionary")Set dOSS &＃61; CreateObject("Scripting.Dictionary")With Worksheets("ip对应地市名工具")For i &＃61; 1 To .[A65536].End(xlUp).RowdCity.add .Cells(i, 1).Value, .Cells(i, 2).ValuedOSS.add .Cells(i, 1).Value, .Cells(i, 3).ValueNextEnd WithDim lRow%, leftIp$lRow &＃61; [A65536].End(xlUp).Row
&＃39; 地市 OSS归属 IP 网元名 删除异频结果On Error Resume NextFor i &＃61; 2 To lRowIf Cells(i, 1).Value <> "" ThenleftIp &＃61; Left(Cells(i, 1).Value, 6)Cells(i, 6).formula &＃61; dCity(leftIp)Cells(i, 7).formula &＃61; dOSS(leftIp)Cells(i, 8) &＃61; Cells(i, 1)Cells(i, 9) &＃61; Cells(i, 2)Cells(i, 10) &＃61; IIf(Cells(i, 4) &＃61; "", "断站", "执行成功")End IfNext&＃39;此处妙&＃xff0c;多重功能&＃xff1a;删除A列空行&＃xff0c;不正确IP&＃xff0c;8.137站点Columns("F:F").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
&＃39; 格式化Application.ScreenUpdating &＃61; TrueEnd SubSub findBrokenStation()Dim arr, brr, crr, lRow%, lRow2%lRow &＃61; [A65535].End(xlUp).Rowarr &＃61; WorksheetFunction.Transpose(Range("A2:A" & lRow & "").Value) &＃39;删除的IP列With Worksheets("全合并-找断站")lRow2 &＃61; .[A65535].End(xlUp).Rowbrr &＃61; WorksheetFunction.Transpose(.Range("D2:D" & lRow2 & "").Value) &＃39;全合并-找断站的D列基站IPcrr &＃61; WorksheetFunction.Transpose(.Range("A2:A" & lRow2 & "").Value) &＃39;全合并-找断站的A列基站名称End WithDim ip(2000, 1 To 1), eNodeB(2000, 1 To 1)j &＃61; 0For i &＃61; 1 To UBound(brr)If UBound(Filter(arr, brr(i))) &＃61; -1 Thenip(j, 1) &＃61; brr(i)eNodeB(j, 1) &＃61; crr(i)j &＃61; j &＃43; 1End IfNextlRow &＃61; [A65536].End(xlUp).Row &＃43; 1Dim iUb%iUb &＃61; UBound(ip)Range(Cells(lRow, 1), Cells(lRow &＃43; iUb, 1)) &＃61; ipRange(Cells(lRow, 2), Cells(lRow &＃43; iUb, 2)) &＃61; eNodeB&＃39;除重ActiveSheet.Range("$A$1:$E$65536").RemoveDuplicates Columns:&＃61;1, Header:&＃61;xlYesEnd SubSub importLog()&＃39;选择路径Dim arr, brr, crrDim fd As FileDialogSet fd &＃61; Application.FileDialog(msoFileDialogFilePicker)If fd.Show <> -1 Then &＃39;不等于-1表示没有选取任何文件Set fd &＃61; NothingExit SubEnd If&＃39; 清除原数据lRow &＃61; [A65536].End(xlUp).RowIf lRow > 1 Then Rows("2:" & lRow).DeleteFor Each a In fd.SelectedItemsIf Right(a, 4) &＃61; ".log" ThenOpen a For Input As #1arr &＃61; Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbLf)Close #1aUb &＃61; UBound(arr)ReDim crr(aUb, 4)For i &＃61; 0 To aUbbrr &＃61; Split(arr(i), ",")For j &＃61; 0 To UBound(brr)crr(i, j) &＃61; brr(j)NextNextlRow &＃61; [A65536].End(xlUp).Row &＃43; 1Range(Cells(lRow, 1), Cells(lRow &＃43; aUb, 5)) &＃61; crrEnd IfNextSet fd &＃61; NothingEnd SubSub formatting()
&＃39; 置中&＃xff0c;加边框&＃xff0c;上色Range("G1:H4").SelectWith Selection.HorizontalAlignment &＃61; xlCenter.VerticalAlignment &＃61; xlCenter.WrapText &＃61; False.Orientation &＃61; 0.AddIndent &＃61; False.IndentLevel &＃61; 0.ShrinkToFit &＃61; False.ReadingOrder &＃61; xlContext.MergeCells &＃61; FalseEnd WithSelection.Borders(xlDiagonalDown).LineStyle &＃61; xlNoneSelection.Borders(xlDiagonalUp).LineStyle &＃61; xlNoneWith Selection.Borders(xlEdgeLeft).LineStyle &＃61; xlContinuous.ColorIndex &＃61; 0.TintAndShade &＃61; 0.Weight &＃61; xlThinEnd WithWith Selection.Borders(xlEdgeTop).LineStyle &＃61; xlContinuous.ColorIndex &＃61; 0.TintAndShade &＃61; 0.Weight &＃61; xlThinEnd WithWith Selection.Borders(xlEdgeBottom).LineStyle &＃61; xlContinuous.ColorIndex &＃61; 0.TintAndShade &＃61; 0.Weight &＃61; xlThinEnd WithWith Selection.Borders(xlEdgeRight).LineStyle &＃61; xlContinuous.ColorIndex &＃61; 0.TintAndShade &＃61; 0.Weight &＃61; xlThinEnd WithWith Selection.Borders(xlInsideVertical).LineStyle &＃61; xlContinuous.ColorIndex &＃61; 0.TintAndShade &＃61; 0.Weight &＃61; xlThinEnd WithWith Selection.Borders(xlInsideHorizontal).LineStyle &＃61; xlContinuous.ColorIndex &＃61; 0.TintAndShade &＃61; 0.Weight &＃61; xlThinEnd WithRange("G1:H1").SelectWith Selection.Interior.Pattern &＃61; xlSolid.PatternColorIndex &＃61; xlAutomatic.Color &＃61; 5287936.TintAndShade &＃61; 0.PatternTintAndShade &＃61; 0End WithRange("G4:H4").SelectWith Selection.Interior.Pattern &＃61; xlSolid.PatternColorIndex &＃61; xlAutomatic.ThemeColor &＃61; xlThemeColorAccent5.TintAndShade &＃61; 0.599993896298105.PatternTintAndShade &＃61; 0End WithRows("2:3").SelectSelection.RowHeight &＃61; 21Range("G3").SelectEnd Sub