原表
目标统计汇总表
VBA代码
Private Sub CommandButton1_Click()
Dim arr, i&, n&, d As Object, s$, a()
arr = Sheet1.Range("A1").CurrentRegion
Set d = CreateObject("Scripting.Dictionary")
For i = 3 To UBound(arr)
s = arr(i, 7) & "|" & arr(i, 2) & "|" & arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5)
If Not d.Exists(s) Then
n = n + 1: ReDim Preserve a(1 To 12, 1 To n)
d(s) = arr(i, 6)
a(1, n) = arr(i, 2) '名称
a(2, n) = arr(i, 7) '材质
a(3, n) = arr(i, 3) '长
a(4, n) = arr(i, 4) '宽
a(5, n) = arr(i, 5) '厚
Else
d.Item(s) = d.Item(s) + arr(i, 6)
End If
Next
Sheet3.Range("A5:L10000").ClearContents
Sheet3.Range("A5:L10000").Borders.LineStyle = xlNone
If n = 0 Then Exit Sub
Sheet3.Range("A5").Resize(d.Count, UBound(a)) = WorksheetFunction.Transpose(a)
Sheet3.Range("G5").Resize(d.Count, 1) = WorksheetFunction.Transpose(d.items)
Sheet3.Range("A5").Resize(d.Count, 12).Borders.LineStyle = xlContinuous
End Sub
运行后的效果
指定起点和止点，画线，上色
Sub DrawLine(StartX As Variant, StartY As Variant, EndX As Variant, EndY As Variant)
ActiveSheet.Shapes.AddLine(StartX, StartY, EndX, EndY).Select
Selection.ShapeRange.Line.Weight = 2
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
End Sub
Sub lqxs()
Dim ks, js, shp As Shape, a, b, a1, a2, b1, b2, x1, y1, x2
For Each shp In Sheet1.Shapes
If shp.Type = 9 Then shp.Delete
Next
ks = Range("a1").Value: js = Range("b1").Value
a = ks * 24: b = js * 24
a1 = Int(a): a2 = a - a1
b1 = Int(b): b2 = b - b1
x1 = Cells(4, a1 - 5).Left + Cells(4, a1 - 5).Width * a2: y1 = Cells(4, a1 - 5).Top + Cells(4, a1 - 5).Height * 0.5
x2 = Cells(4, b1 - 5).Left + Cells(4, b1 - 5).Width * b2
DrawLine x1, y1, x2, y1
Range("a1").Select
End Sub
前景色：表外面的线条及颜色：
红色：.Color = -16776961。兰色：.Color = -4165632。黑色：.Color = -16250872。
背景色：.Interior.Color
Sheet3.Range("E3:F6").Interior.Color = 69000 '紫红色色块E3：F6，背景
索引色：rng.Interior.ColorIndex = 3，这里的3代表红色；
为了减轻难度，直接把 color改为.ColorIndex=下面这56个编号中的一个就OK了。
分量颜色值：非常大的负数。看起来难以接受，原理是色号代码的二进制如#CCC，然后转成二进制数字。就成了如下这样的大数据。为了减轻难度，直接把 color改为.ColorIndex=上面这56个编号中的一个就OK了。
在进行基于word2007的二次开发，需要取字符的颜色值，进而得到颜色的RGB分量值。但是font.color不一定代表真实的颜色值。具体情况如下:
当我选中某些字符后，打开字体对话框，选择字体颜色下拉框中“主题颜色”的某种颜色后，再通过代码font.color获取刚才所设置的字符颜色，发现值是一个非常大的负数，选择不同的主题颜色对应不同的值，此值与具体颜色无关，如-587137025，-671023105，-738131969等。真实的颜色值是24位的，上述负值超出此范围。这不是真实的颜色值，我猜这是主题颜色表中的索引号，我想问可否将上述索引号映射为真实的颜色值或者其RGB分量。
Private Sub CommandButton3_Click()
Range("D2:G" & [G65536].End(xlUp).Row).Font.Color = -16776961 '从D列2行到G列有内容的区域行，定义色块红色字
End Sub
Sub Macro1()
For mycolumn= 1 To 100
For myrow= 2 To 5
' 从第1行到100行，vba的下标从1 开始，非传统的0开始
' 从第2列到第5列
ActiveSheet.Cells(myrow, mycolumn).Select
' 选中循环中的单元格
If ActiveCell.Value = "" Then
Else
With ActiveCell.Characters(Start:=1, Length:=0).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=1, Length:=8).Font
' 1~8字符 设置为红色
.Name = "宋体"
.FontStyle = "常规"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=9, Length:=1).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=10, Length:=5).Font
' 10~14字符 设置为深蓝色
.Name = "宋体"
.FontStyle = "常规"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -4165632
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Selection.Font.Bold = True
End If
Next
Next
End Sub
Private Sub CommandButton4_Click()
Sheet3.Range("E3:F6").Interior.Color = 69000 '紫红色色块E3：F6，背景
End Sub
来源：oschina
链接：https://my.oschina.net/u/4299887/blog/4406407