[已解决]因为对VB一窍不通，写的东西太复杂，麻烦大神看一下能精简一下嘛，感谢

tudigeming · 发表于 2017-9-7 15:13

感觉对于大神来说是很简单的，自己弄的就复杂
具体表内容为
微信截图_20170907151201.png

宏内容为
Sub h1()

   Dim a, b, c, d, e, f

   b = Cells(Rows.Count, 11).End(xlUp).Row
   a = Cells(b, Columns.Count).End(xlToLeft).Column
   c = Cells(b, a - 3) - Cells(b - 1, a - 3)
   d = Cells(b, a - 2) - Cells(b - 1, a - 2)
   e = Cells(b, a) - Cells(b - 1, a)

   Range("d" & b).Select
   ActiveCell.FormulaR1C1 = c
   ActiveCell.Offset(, -1) = "增加"
   If Val(c) < 0 Then
   ActiveCell.Value = -c
   ActiveCell.Offset(, -1) = "下降"
   End If
   ActiveCell.Offset(, -2) = "当日新增工单"
   ActiveCell.Offset(, 1) = "户"
   ActiveCell.Offset(, -2).Select
   With Selection.Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .Color = 15773696
      .TintAndShade = 0
      .PatternTintAndShade = 0
End With
With Selection.Font
      .ThemeColor = xlThemeColorDark1
      .TintAndShade = 0
End With

   Range("d" & b + 1).Select
   ActiveCell.FormulaR1C1 = d
   ActiveCell.Offset(, -1) = "增加"
   If Val(d) < 0 Then
   ActiveCell.Value = -d
   ActiveCell.Offset(, -1) = "下降"

   End If
   ActiveCell.Offset(, -2) = "当日竣工工单"
   ActiveCell.Offset(, 1) = "户"
   ActiveCell.Offset(, -2).Select
   With Selection.Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .Color = 15773696
      .TintAndShade = 0
      .PatternTintAndShade = 0
End With
With Selection.Font
      .ThemeColor = xlThemeColorDark1
      .TintAndShade = 0
End With

   Range("d" & b + 2).Select
   ActiveCell.FormulaR1C1 = e
   ActiveCell.Offset(, -1) = "增加"
   If Val(e) < 0 Then
   ActiveCell.Value = -e
   ActiveCell.Offset(, -1) = "下降"

   End If
   ActiveCell.Offset(, -2) = "当日剩余工单"
   ActiveCell.Offset(, 1) = "户"
   ActiveCell.Offset(, -2).Select
   With Selection.Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .Color = 15773696
      .TintAndShade = 0
      .PatternTintAndShade = 0
   End With
   With Selection.Font
      .ThemeColor = xlThemeColorDark1
      .TintAndShade = 0
End With
End Sub

最佳答案

月排行榜 / 总排行榜

grf1973

2017-9-7 15:40

Sub h1()
Dim a, b, c, d, e, zj
b = Cells(Rows.Count, 11).End(xlUp).Row
a = Cells(b, Columns.Count).End(xlToLeft).Column
c = Cells(b, a - 3) - Cells(b - 1, a - 3) '当日新增
d = Cells(b, a - 2) - Cells(b - 1, a - 2) '当日竣工
e = Cells(b, a) - Cells(b - 1, a) '当日剩余
zj = IIf(c > 0, "增加", "下降") '增加or下降
Cells(b, "D").Resize(1, 4) = Array("当日新增工单", zj, Abs(c), "户")
zj = IIf(d > 0, "增加", "下降")
Cells(b + 1, "D").Resize(1, 4) = Array("当日竣工工单", zj, Abs(d), "户")
zj = IIf(e > 0, "增加", "下降")
Cells(b + 2, "D").Resize(1, 4) = Array("当日剩余工单", zj, Abs(e), "户")
Cells(b, "D").Resize(1, 3).Interior.Color = 15773696 '调单元格颜色
Cells(b, "D").Resize(1, 3).Font.ThemeColor = xlThemeColorDark1 '调字体格式
End Sub

复制代码

跳转到最佳答案楼层

grf1973 · 发表于 2017-9-7 15:40

这个最佳答案由 grf1973 给出，感谢 grf1973 的回答。

单击隐藏图章

Sub h1()
Dim a, b, c, d, e, zj
b = Cells(Rows.Count, 11).End(xlUp).Row
a = Cells(b, Columns.Count).End(xlToLeft).Column
c = Cells(b, a - 3) - Cells(b - 1, a - 3) '当日新增
d = Cells(b, a - 2) - Cells(b - 1, a - 2) '当日竣工
e = Cells(b, a) - Cells(b - 1, a) '当日剩余
zj = IIf(c > 0, "增加", "下降") '增加or下降
Cells(b, "D").Resize(1, 4) = Array("当日新增工单", zj, Abs(c), "户")
zj = IIf(d > 0, "增加", "下降")
Cells(b + 1, "D").Resize(1, 4) = Array("当日竣工工单", zj, Abs(d), "户")
zj = IIf(e > 0, "增加", "下降")
Cells(b + 2, "D").Resize(1, 4) = Array("当日剩余工单", zj, Abs(e), "户")
Cells(b, "D").Resize(1, 3).Interior.Color = 15773696 '调单元格颜色
Cells(b, "D").Resize(1, 3).Font.ThemeColor = xlThemeColorDark1 '调字体格式
End Sub

复制代码

tudigeming · 发表于 2017-9-8 14:17

谢谢指点，最后这个改一下就是我需要的了
Cells(b, "D").Resize(3,1).Interior.Color = 15773696 '调单元格颜色
Cells(b, "D").Resize(3,1).Font.ThemeColor = xlThemeColorDark1 '调字体格式

		自动登录	找回密码
密码			注册