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