VBA中的动态格式化特定细胞

Question

我是VBA的新手，无法弄清楚如何动态格式化我记录的宏的总和和费用单元。我需要添加突出显示，大胆，更改样式中的货币，更改数字格式和边界。报告并不总是相同的，因此格式需要动态。下面的屏幕截图显示了我喜欢的最终结果。任何帮助都非常感谢！

以下是我目前到目前为止所拥有的，

   Range("M1").Activate
   ActiveWindow.SmallScroll ToRight:=9
   Range("A:A,M:M,Q:T,V:V").Select
   Range("V1").Activate
   ActiveWindow.SmallScroll ToRight:=9
   Range("A:A,M:M,Q:T,V:V,X:X,AA:AB").Select
   Range("AA1").Activate
   Selection.Delete Shift:=xlToLeft
   Columns("V:BM").Select
   Selection.Delete Shift:=xlToLeft
   ActiveWindow.ScrollColumn = 1
   Range("A1").Select
   Range(Selection, Selection.End(xlDown)).Select
   Range(Selection, Selection.End(xlToRight)).Select
   Selection.Columns.AutoFit
   ActiveWindow.ScrollColumn = 13
   ActiveWindow.ScrollColumn = 19
   ActiveWindow.ScrollColumn = 11
   ActiveWindow.ScrollColumn = 8
   ActiveWindow.SmallScroll ToRight:=3
   ActiveWindow.ScrollColumn = 8
   ActiveWindow.SmallScroll Down:=129
   Lastrow = ThisWorkbook.Sheets("sheet1").Cells(Rows.Count, 10).End(xlUp).Row
   ThisWorkbook.Sheets("sheet1").Range("I" & Lastrow + 1) = "Total Sales"
   ThisWorkbook.Sheets("sheet1").Range("I" & Lastrow + 2) = "Total Fee"
   ThisWorkbook.Sheets("sheet1").Range("j" & Lastrow + 1) = WorksheetFunction.Sum(ThisWorkbook.Sheets("sheet1").Range("j2:j" & Lastrow))
   ThisWorkbook.Sheets("sheet1").Range("j" & Lastrow + 2) = WorksheetFunction.Sum(ThisWorkbook.Sheets("sheet1").Range("j2:j" & Lastrow)) * 0.01

End Sub

Answer 1

动态排列数据

Sub ArrangeData()
   
   With ThisWorkbook.Worksheets("Sheet1")
       
       ' Delete columns.
       .Range("A:A,M:M,Q:T,V:V,X:X,AA:AB,AF:BW").Delete Shift:=xlToLeft
   
       ' Totals
       
       ' Calculate
       Dim lRow As Long: lRow = .Cells(.Rows.Count, "J").End(xlUp).Row
       Dim Total As Double: Total = Application.Sum(.Range("J2:J" & lRow))
       
       ' Reference the totals' range (4 cells).
       With .Range("I" & lRow + 1, "J" & lRow + 2)
           
           ' Write.
           .Cells(1).Value = "Total Sales"
           .Cells(2).Value = Total
           .Cells(3).Value = "Total Fee"
           .Cells(4).Value = Total * 0.01
       
           ' Format
           .Font.Bold = True
           .Interior.Color = vbYellow ' 65535
           .BorderAround xlContinuous
           .Borders(xlInsideVertical).LineStyle = xlContinuous
           .Borders(xlInsideHorizontal).LineStyle = xlContinuous
           .Columns(2).NumberFormat = "[$-en-US]#,##0.00"
       
       End With
       
       ' Autofit columns.
       Dim lCol As Long: lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
       .Range("A1", .Cells(1, lCol)).EntireColumn.AutoFit
   
   End With
   
End Sub