小菜鸟
程序员文章站
2022-07-01 20:29:27
...
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
上一篇: dialo
下一篇: 关于前端安全的几个提示