将电子表格的一半格式化为红色，然后向下填充直到最后一行

我有一个宏，它成功地获取了一个有 44 列的表格，并将其减少到 12 列。它分割了顶部部分（我们的供应商没有发送任何库存，总列中的单元格将显示 0）并将其粘贴在工作表的顶部，并插入复选框（在一定程度上）。

我非常努力地制作一个降价表，但它无法正确显示。下面是（上）数据当前的样子和（下）期望的结果！ :-)

理想情况下，我想做的是使顶部部分格式为红色（我们没有发送任何库存），并且复选框被填充到最后一行。我不知道该怎么做。我还想按“A”列（代码）对非红色部分进行排序。

非常欢迎任何帮助！

Thanks

Sub separate()
    Columns("A:N").Select
    Range("N1").Activate
    Selection.Delete Shift:=xlToLeft
    Columns("A:J").Select
    Range("J1").Activate
    Selection.Delete Shift:=xlToLeft
    Range("D5").Select
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "CHK"
    Columns("F:F").Select
    Selection.Cut
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Columns("G:J").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("L:L").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Range("F5").Select
    Columns("C:C").Select
    Selection.Cut
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "VAT"
    Range("J6").Select
Dim wb As Workbook, ws As Worksheet, myrange As Range
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1")
Set range_i = Nothing
counter = 0
Tre = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For Tr = 2 To Tre
If ws.Cells(Tr, 13) = 0 Then
    If Not myrange Is Nothing Then
        Set myrange = Union(myrange, Range(ws.Cells(Tr, 1), ws.Cells(Tr, 13)))
    Else
        Set myrange = Range(ws.Cells(Tr, 1), ws.Cells(Tr, 13))
    End If
    counter = counter + 1
End If

If Not range_i Is Nothing Then
    If ws.Cells(Tr, 13) > 0 Then
        Set range_i = Union(range_i, Range(ws.Cells(Tr, 1), ws.Cells(Tr, 13)))
    End If
Else
    If ws.Cells(Tr, 13) > 0 Then
        Set range_i = Range(ws.Cells(Tr, 1), ws.Cells(Tr, 13))
    End If
End If
Next Tr
Sheets.Add.Name = "summary"
Set Tws = wb.Sheets("summary")
myrange.Copy
Tws.Range("A1").PasteSpecial
range_i.Copy
Tws.Range(Cells(1 + counter, 1), Cells(1 + counter, 13)).PasteSpecial
    Sheets("Sheet1").Range("A1:M1").Copy
    Sheets("summary").Select
    Range("A1").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
Application.DisplayAlerts = False
Sheets(Array("Sheet1")).Delete
Application.DisplayAlerts = True
    Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "o"
    Columns("D:D").Select
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D268")
    Range("D2:D268").Select
    Range("E6").Select
End Sub

首先，您可能会从阅读中受益如何避免在 Excel VBA 中使用 Select https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba这可以帮助提高代码的整体功能和性能，更不用说它可能有助于大大简化代码。

有几种方法可以实现您的目标。

我首先想到的是循环遍历一个设定范围（也许您可以根据当前代码中的某些内容来设置它），并且如果列 G 值是0将行文本颜色设置为红色。

例如;

Sub redtext()
    Dim TargetRow As Long
    
    For TargetRow = 1 To 10
        If Cells(TargetRow, "G").Value = "0" Then
            Range("A" & TargetRow & ":J" & TargetRow).Font.Color = vbRed
        End If
    Next TargetRow
End Sub

注意：上面是一个循环第 1 行到第 10 行的简单示例。您应该explicit引用您的对象（例如引用工作表/工作簿，就像没有此对象一样Cells()有一个implicit参考ActiveSheet.