Question

我有一个使用此代码的宏，它运行得很好，我保存它的文件，但是当我尝试在另一个excel文件上运行代码仍然运行但在ChangeColor方法中，它不会填充单元格。它一步一步地运行它只是不填充颜色。这是我的代码。

Sub ChangeColor()

'---------------------------ChangeColor-------------------------

Dim rCell As Range
Worksheets("MSS Open Purchase Orders").Select
With Sheet1
    For Each rCell In .Range("N4", .Cells(.Rows.Count, 14).End(xlUp)).Cells
        If rCell.Value <= Date Then
            rCell.Interior.Color = vbRed
             ElseIf rCell.Value <= Date + 7 Then
            rCell.Interior.Color = RGB(255, 102, 0)
        ElseIf rCell.Value <= Date + 30 Then
            rCell.Interior.Color = vbYellow

        Else
            rCell.Interior.Color = vbGreen
        End If
    Next rCell
End With

'------------------------------I-------------------------------

 Worksheets("I").Select
With Sheet2
    For Each rCell In .Range("N2", .Cells(.Rows.Count, 14).End(xlUp)).Cells
        If rCell.Value <= Date Then
            rCell.Interior.Color = vbRed
            ElseIf rCell.Value <= Date + 7 Then
            rCell.Interior.Color = RGB(255, 102, 0)
        ElseIf rCell.Value <= Date + 30 Then
            rCell.Interior.Color = vbYellow

        Else
            rCell.Interior.Color = vbGreen
        End If
    Next rCell
 End With

 '------------------------------O-------------------------------
   Worksheets("O").Select
With Sheet3
    For Each rCell In .Range("N2", .Cells(.Rows.Count, 14).End(xlUp)).Cells
        If rCell.Value <= Date Then
            rCell.Interior.Color = vbRed
            ElseIf rCell.Value <= Date + 7 Then
            rCell.Interior.Color = RGB(255, 102, 0)
        ElseIf rCell.Value <= Date + 30 Then
            rCell.Interior.Color = vbYellow

        Else
            rCell.Interior.Color = vbGreen
        End If
    Next rCell
 End With

   '------------------------------E-------------------------------
   Worksheets("E").Select
With Sheet4
    For Each rCell In .Range("N2", .Cells(.Rows.Count, 14).End(xlUp)).Cells
        If rCell.Value <= Date Then
            rCell.Interior.Color = vbRed
             ElseIf rCell.Value <= Date + 7 Then
            rCell.Interior.Color = RGB(255, 102, 0)
        ElseIf rCell.Value <= Date + 30 Then
            rCell.Interior.Color = vbYellow

        Else
            rCell.Interior.Color = vbGreen
        End If
    Next rCell
 End With

  '------------------------------C-------------------------------
    Worksheets("C").Select
With Sheet5
    For Each rCell In .Range("N2", .Cells(.Rows.Count, 14).End(xlUp)).Cells
        If rCell.Value <= Date Then
            rCell.Interior.Color = vbRed
             ElseIf rCell.Value <= Date + 7 Then
            rCell.Interior.Color = RGB(255, 102, 0)
        ElseIf rCell.Value <= Date + 30 Then
            rCell.Interior.Color = vbYellow

        Else
            rCell.Interior.Color = vbGreen
        End If
    Next rCell
 End With

'------------------------------------Sort---------------------------------------


 ActiveWorkbook.Worksheets("MSS Open Purchase Orders").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("MSS Open Purchase Orders").Sort.SortFields.Add Key _
    :=Range("N4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("MSS Open Purchase Orders").Sort
    .SetRange Range("N4:N58")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
 End With

End Sub

任何帮助都表示赞赏刚刚开始在excel中使用vba

Answer 1

有很多方法可以执行此操作，但如果您希望代码处理的工作簿是活动工作簿，则可以像在此示例中一样引用它

ActiveWorkbook.Worksheets("MSS Open Purchase Orders").Select

要@Zeno点，你可以放弃

With Sheet1 and End With

等。并删除. s。

Answer 2

我发现您的代码存在两个主要问题

你已多次重复这段代码。你可以使用一个公共子并继续调用它。
您应该避免使用.Select/.Activate/Selection/Activecell/Activesheet/Activeworkbook您可能希望看到THIS

以下是您的代码的优化方式。这只是一个例子。请根据您的需要进行修改。

<强> UNTESTED

Sub ChangeColor()
    Dim wb As Workbook, ws As Worksheet

    '~~> Here change it to the relevant workbook
    Set wb = ThisWorkbook

    '~~> Here set the worksheets you want to work with
    Set ws = wb.Worksheets("MSS Open Purchase Orders")

    '~~> Do the coloring
    ColorCells ws

    '~~> Again set the worksheets you want to work with
    Set ws = wb.Worksheets("I")

    '~~> Do the coloring
    ColorCells ws

    '~~> Again set the worksheets you want to work with
    Set ws = wb.Worksheets("O")

    '~~> Do the coloring
    ColorCells ws

    '
    '~~> And So On
    '
End Sub

'~~> Common Sub to color the sheets
Sub ColorCells(sHt As Worksheet)
    Dim rCell As Range

    With sHt
        For Each rCell In .Range("N2", .Cells(.Rows.Count, 14).End(xlUp)).Cells
            If rCell.Value <= Date Then
                rCell.Interior.Color = vbRed
            ElseIf rCell.Value <= Date + 7 Then
                rCell.Interior.Color = RGB(255, 102, 0)
            ElseIf rCell.Value <= Date + 30 Then
                rCell.Interior.Color = vbYellow
            Else
                rCell.Interior.Color = vbGreen
            End If
        Next rCell
    End With
End Sub

没有颜色填写不同文件中的单元格

2 个答案: