Sub direct_Price()
''定义变量
Dim cRows As Integer '总行数
Dim cColumns As Integer '总列数
Dim HEADERCOLORINDEX As Integer '表头的背景色
Dim cTemp As Integer '临时计数
Dim sTempString As String '临时字符串变量
Dim i As Integer '临时计数
Dim j As Integer '临时计数
Dim rowIndex As Integer '临时指示处理到哪里
Dim colIndex As Integer '临时指示处理到哪里
Dim tempRndColor As Integer '临时生成的颜色
Dim TABLENAME As String '待处理的表名
Dim colorIndex As String '颜色索引名字
''''''''''''''''''''''''''''''''''''''''''''表头的背景色
HEADERCOLORINDEX = 15
colorIndex = 36 '颜色从33开始是比较浅的颜色
TABLENAME = "direct_Price"
'关闭所有弹出的警告消息
Application.DisplayAlerts = False
'设置需要处理的单元表
Sheets(TABLENAME).Select
'取单元表的总列数与总行数
cRows = Sheets(TABLENAME).UsedRange.Rows.Count
cColumns = Sheets(TABLENAME).UsedRange.Columns.Count
''''''''''''''''''''''''''''''''''''''''''''''
'选择所有的单元格
Range(Cells(1, 1), Cells(cRows, cColumns)).Select
'设置该表中所有单元行高为11.25
Selection.RowHeight = 11.25
'设置该表中所有单元行高为11.25
Selection.RowHeight = 11.25
'设置所有的边框
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
'并且拆分所有的单元格
With Selection
.MergeCells = False '拆分单格
End With
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
'删除第一列,注意这里必须先拆分单格，再删除第一列，否则一次就会把合并单元格所在列全部删除
Range(Cells(1, 1), Cells(1, 1)).Select
Selection.EntireColumn.Delete
'Selection.EntireColumn.Delete
'向表头添加一行
Rows("1:1").Select
Selection.Insert
Columns("A:A").Select
Selection.ColumnWidth = 9.29
Columns("B:B").Select
Selection.ColumnWidth = 6.71
Columns("C:C").Select
Selection.ColumnWidth = 15.29
Columns("D:D").Select
Selection.ColumnWidth = 29.86
Columns("E:E").Select
Selection.ColumnWidth = 12.29
Columns("F:F").Select
Selection.ColumnWidth = 12.29
'''''''''''''''''''''''''''''''''''设定单元格A1:A2''''''''''''''''''''
'合并A1:A2单元格
Range("A1:A2").Select
'将数据写回
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
'往该单元格中写入Usage_Var
ActiveCell.FormulaR1C1 = "Price"
'设置该单元格字体格式
With ActiveCell.Characters(Start:=1, Length:=5).Font
.Name = "Arial"
.FontStyle = "加粗 倾斜"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.colorIndex = 2
End With
'单元格设定边框
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = 56
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.colorIndex = 5
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
'''''''''''''''''''''''''''''设定头两行的内部样式'''''''''''''''''''''''
Range("B1:B2").Select
Selection.Merge
Range("C1:C2").Select
Selection.Merge
Range("D1:D2").Select
Selection.Merge
Range("B1:D2").Select
'设置头两行行高为11.25
Selection.RowHeight = 14.25
With Selection.Font
.Name = "Arial"
.FontStyle = "加粗"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.colorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection.Interior
.colorIndex = HEADERCOLORINDEX
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Range("B1:B2").Select
ActiveCell.FormulaR1C1 = "Type"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Arial"
.FontStyle = "加粗"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.colorIndex = 5
End With
Range("E1:F1").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "加粗"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.colorIndex = 5
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection.Interior
.colorIndex = HEADERCOLORINDEX
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
ActiveCell.FormulaR1C1 = "Price"
Range("E2:F2").Select
'设置头两行行高为11.25
Selection.RowHeight = 14.25
With Selection.Font
.Name = "Arial"
.FontStyle = "加粗"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.colorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Interior
.colorIndex = HEADERCOLORINDEX
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
'加第一二行边框
Range("A1:F2").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
'去掉第三行的:号
'sTempString = Right(Cells(3, 1), Len(Cells(3, 1)) - 3)
'ActiveCell.FormulaR1C1 = sTempString
i = 2
j = 1
'外层循环判断是否都合并完成,这里插入了一行，加1
While i <= cRows
' i = i + 1
Range(Cells(i + 1, j), Cells(i + 1, j)).Select
'去掉分类行中的:号
If (Len(Cells(i + 1, j)) >= 3) Then
''''''''''''''如果是分格的界限''''''''''''''''''''''''''''''''''''
If (Left(Cells(i + 1, j), 3) = " : ") Then
Range(Cells(i + 1, j), Cells(i + 1, cColumns)).Select
'对第三行进行设定
'设置头两行行高为11.25
Selection.RowHeight = 18
With Selection.Interior
.colorIndex = 2
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
'合并前两格
'先将其合并
With Selection
.HorizontalAlignment = xlLeft '靠左对齐
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'合并
Selection.Merge
'对其设定字体风格
With Selection.Font
.Name = "Arial"
.FontStyle = "加粗 倾斜"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.colorIndex = 3
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
sTempString = Right(Cells(i + 1, j), Len(Cells(i + 1, j)) - 3)
ActiveCell.FormulaR1C1 = sTempString
i = i + 1
End If
End If
i = i + 1
'加1后判断是否到了表尾，没有继续合并处理
'If (i <= cRows + 1) Then
rowIndex = i
'取出Cells(i, j)的内容
sTempString = Cells(i, j)
'循环判断下一个单元格是否和上一个单元格相等，不是则表示到此该合并
While sTempString = Cells(i + 1, j) And i <= cRows
i = i + 1
Wend
''''''''''''''''''''''''''''''''''''设置第一列''''''''''''''''''''''''''''''''''''''''
'跳出循环表示已经到此该将rowIndex 和 i行合并
Range(Cells(rowIndex, j), Cells(i, j)).Select
Selection.Merge
'将原来内容填充进来
ActiveCell.FormulaR1C1 = sTempString
'设合并后的单元格的边框
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.Font.FontStyle = "加粗"
''''''''''''''''''''''''''''''''''''设置第一列结束''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''设置第二列'''''''''''''''''''''''''''''''''''''''''''''
Range(Cells(rowIndex, j + 1), Cells(i, j + 1)).Select
'设置字体
With Selection.Font
.Name = "Arial"
.FontStyle = "加粗"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.colorIndex = 5
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.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
.Weight = xlThin
.colorIndex = 56
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = 56
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = 56
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = 56
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'''''''''''''''''''''''''''''设置第二列结束'''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''修改原来单元格的数据格式''''''''''''''''''''''''''''''''
''''''''''''''''''''''''首先向任一无用的单元格写入数据
Range(Cells(cRows + 2, cColumns), Cells(cRows + 2, cColumns)).Select
ActiveCell.FormulaR1C1 = "1"
'将其格式拷贝
Selection.Copy
'复制格式
Range(Cells(rowIndex, j + 4), Cells(i, cColumns)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Selection.NumberFormatLocal = "_*#,##0.00000"
'清除原来内容
Range(Cells(cRows + 2, cColumns), Cells(cRows + 2, cColumns)).Select
Selection.ClearContents
''''''''''''''''''''''''设定数据格式完成''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''统一设置该区域的颜色''''''''''''''''''''''''''''''''''''''''''''''
'设置内部填充
Range(Cells(rowIndex, j), Cells(i, cColumns)).Select
colorIndex = colorIndex + 1
If colorIndex > 39 Then
colorIndex = 33
End If
With Selection.Interior
.colorIndex = colorIndex '颜色
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
''''''''''''''''''''''''''''''''''统一设置该区域的颜色结束''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''设置剩余的列'''''''''''''''''''''''''''''''''''''''''''''
Range(Cells(rowIndex, j + 2), Cells(i, cColumns)).Select
'设置字体
With Selection.Font
.Name = "Arial"
.FontStyle = "常规"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.colorIndex = xlAutomatic
End With
'设置第6列
Range(Cells(rowIndex, j + 4), Cells(i, j + 5)).Select
'设置字体
With Selection.Font
.Name = "Arial"
.FontStyle = "常规"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.colorIndex = 3
End With
'''''''''''''''''''''''''''''设置全部的边框'''''''''''''''''''''''''''''''''''''''''''''
Range(Cells(rowIndex, j), Cells(i, cColumns)).Select
'设置边框
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
' .LineStyle = xlContinuous
.Weight = xlThin
' .colorIndex = xlAutomatic
End With
Wend
Range(Cells(rowIndex - 1, 1), Cells(rowIndex - 1, cColumns)).Select
Selection.MergeCells = False
Range(Cells(rowIndex - 1, cColumns - 1), Cells(rowIndex - 1, cColumns - 1)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "加粗"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.colorIndex = xlAutomatic
End With
With Selection.Interior
.colorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
ActiveCell.FormulaR1C1 = "Average"
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Arial"
.FontStyle = "加粗"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.colorIndex = xlAutomatic
End With
Range(Cells(rowIndex - 1, cColumns), Cells(rowIndex - 1, cColumns)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "加粗"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.colorIndex = xlAutomatic
End With
With Selection.Interior
.colorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
ActiveCell.FormulaR1C1 = "Average"
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Arial"
.FontStyle = "加粗"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.colorIndex = xlAutomatic
End With
Range(Cells(rowIndex - 1, cColumns - 1), Cells(rowIndex - 1, cColumns)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.colorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
' .LineStyle = xlContinuous
.Weight = xlThin
' .colorIndex = xlAutomatic
End With
End Sub