小菜鸟

Sub 创建表格()
    Range("A1:F1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A1:F1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A1:F1").Select
    ActiveCell.FormulaR1C1 = "来个例子吧："
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "原因"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "通话"
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "蓝牙"
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "搜网"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "今日新增"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "排名"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "比例"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "波动"
    Range("A1:F1").Select
    With Selection.Font
        .Name = "等线"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With Selection.Font
        .Name = "微软雅黑"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("A2:E5").Select
    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
    With Selection.Font
        .Name = "微软雅黑"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .Name = "微软雅黑"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("A1:F5").Select
    Selection.Font.Bold = True
    Range("A1:F1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("A2:F2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("A3:F3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("A4:F4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("A5:F5").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
End Sub
Sub 弹框()
 Dim str As String
 str = InputBox("请输入导出的文件名：" & Chr(10) & "如把嘎嘎嘎嘎嘎", "输入文件名")
 addnewAllproductmore (str)
 
End Sub

Public Function addnewAllproductmore(str As String)
  Application.ScreenUpdating = False
  ActiveSheet.AutoFilterMode = False
  
  Workbooks.Open (str)
  a = [a65536].End(xlUp).Row - 1
  Workbooks.Close
  
  ThisWorkbook.Sheets(1).Range("c8").Value = a

 
End Function


Sub 文件对话框()

Range("i3").Value = Range("d3").Value

Range("i4").Value = Range("d4").Value
Range("i5").Value = Range("d5").Value
Set FileDialogObject = Application.FileDialog(msoFileDialogFilePicker)

'配置对话框

With FileDialogObject

    .Title = "请选择文件"

    .InitialFileName = "C:\"

End With

'显示对话框

FileDialogObject.Show

'获取选择对话框选择的文件

Set paths = FileDialogObject.SelectedItems

loadFilePath = paths(1)

Range("m1").Value = loadFilePath

add (loadFilePath)


End Sub

Public Function add(loadFilePath As String)
    Dim rngCell As Range
    Dim rngCel As Range
    Dim lngRowCnt As Long
    Dim lngRowCnt1 As Long
    Dim lngRowCnt2 As Long
    Dim lngRowCnt3 As Long
    Dim b As String
    Dim d, ar
    Dim arr, dic, i%
    Dim y
    
    Application.ScreenUpdating = False
    
    Set wb = Workbooks.Open(loadFilePath)
    
    Set dic = CreateObject("scripting.dictionary")
    With ActiveSheet
        arr = .Range("e2:e" & .Range("e65535").End(xlUp).Row)
        For i = 1 To UBound(arr)
            If dic.exists(arr(i, 1)) Then
                dic(arr(i, 1)) = dic(arr(i, 1)) + 1
            Else
                dic(arr(i, 1)) = 1
            End If
        Next
        
    End With
    
    b = Format((Date - 1), "yyyy-m-d") & "  00:00:00"
    
    a = wb.Sheets(1).Range("a65536").End(xlUp).Row - 1
     [a1].CurrentRegion.AutoFilter Field:=4, Criteria1:=b
     For Each rngCell In [a1].CurrentRegion.SpecialCells(xlCellTypeVisible).Areas
        lngRowCnt = lngRowCnt + rngCell.Rows.Count
    Next rngCell
    Set rngCell = Nothing
    
    
        [a1].CurrentRegion.AutoFilter Field:=5, Criteria1:="通话故障"
        For Each rngCel In [a1].CurrentRegion.SpecialCells(xlCellTypeVisible).Areas
            lngRowCnt1 = lngRowCnt1 + rngCel.Rows.Count
        Next rngCel
        Set rngCel = Nothing
    
        [a1].CurrentRegion.AutoFilter Field:=5, Criteria1:="语音故障"
        For Each rngCel In [a1].CurrentRegion.SpecialCells(xlCellTypeVisible).Areas
            lngRowCnt2 = lngRowCnt2 + rngCel.Rows.Count
        Next rngCel
        Set rngCel = Nothing
        
        [a1].CurrentRegion.AutoFilter Field:=5, Criteria1:="显示问题"
        For Each rngCel In [a1].CurrentRegion.SpecialCells(xlCellTypeVisible).Areas
            lngRowCnt3 = lngRowCnt3 + rngCel.Rows.Count
        Next rngCel
        Set rngCel = Nothing
    
    wb.Close False
    
    Range("c8").Value = a
    Range("b8").Value = lngRowCnt - 1
    Range("b3").Value = lngRowCnt1 - 1
    Range("b4").Value = lngRowCnt2 - 1
    Range("b5").Value = lngRowCnt3 - 1
    Range("i1").Value = "更新时间:  " & Date
    Range("k4").Value = b
    ThisWorkbook.Sheets(1).[g2].Resize(dic.Count, 1) = Application.Transpose(dic.Keys)
    ThisWorkbook.Sheets(1).[h2].Resize(dic.Count, 1) = Application.Transpose(dic.Items)
    
    Range("B19").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("B19"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A20:B25")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    On Error Resume Next
    Range("C3").Value = Application.WorksheetFunction.Match(Range("a3"), Columns("h"), False) - 1
    Range("C4").Value = Application.WorksheetFunction.Match(Range("a4"), Columns("h"), False) - 1
End Function