Sub ClearColumns() Dim lastRow As Long Dim i As Long lastRow = Worksheets("A").Cells(Rows.Count, "AT").End(xlUp).Row For i = 2 To lastRow If Worksheets("A").Cells(i, "AT").Value > 0 And Year(Worksheets("A").Cells(i, "BB").Value) <> Year(Date) Then Worksheets("A").Cells(i, "AU").ClearContents Worksheets("A").Cells(i, "AV").ClearContents End If Next i End Sub

这段代码是一个 Excel VBA 的 Sub（子过程），作用是清除工作表中的一些单元格内容。

首先，这段代码声明了一个变量 `lastRow`，用来存储工作表中“AT”列的最后一个非空单元格所在行数。接着，通过一个循环（从第二行到最后一行），遍历了“AT”列中的每一个单元格。

在循环中，首先判断当前单元格的值是否大于 0，如果是，则继续判断该单元格所在行的“BB”列日期是否为当前年份。如果不是，则清除该行的“AU”和“AV”列的内容。

具体操作是通过 `Worksheets("A").Cells(i, "AU").ClearContents` 和 `Worksheets("A").Cells(i, "AV").ClearContents` 语句实现的，这两个语句分别用于清空“AU”和“AV”列的内容。

需要注意的是，这段代码中的“Worksheets("A")”表示当前操作的工作表为名为“A”的工作表，您需要根据实际情况修改该部分的代码。

相关问题

Sub ClearColumns() '提示框 If MsgBox("是否继续执行？", vbYesNo) = vbNo Then Exit Sub End If '原有代码 Dim lastRow As Long Dim i As Long lastRow = Worksheets("A").Cells(Rows.Count, "AT").End(xlUp).Row For i = 2 To lastRow If Worksheets("A").Cells(i, "AT").Value > 0 And Year(Worksheets("A").Cells(i, "BB").Value) <> Year(Date) Then Worksheets("A").Cells(i, "AU").ClearContents Worksheets("A").Cells(i, "AV").ClearContents End If Next i End Sub判断工作表A是否存在，存在则执行，不存在则退出

您可以在 Sub 的开头添加一个判断语句来实现这个功能，代码如下：

Sub ClearColumns()
    '判断工作表"A"是否存在
    If Not WorksheetExists("A") Then
        MsgBox "工作表""A""不存在！"
        Exit Sub
    End If
    
    '提示框
    If MsgBox("是否继续执行？", vbYesNo) = vbNo Then
        Exit Sub
    End If
    
    '原有代码
    Dim lastRow As Long
    Dim i As Long
    lastRow = Worksheets("A").Cells(Rows.Count, "AT").End(xlUp).Row
    For i = 2 To lastRow
        If Worksheets("A").Cells(i, "AT").Value > 0 And Year(Worksheets("A").Cells(i, "BB").Value) <> Year(Date) Then
            Worksheets("A").Cells(i, "AU").ClearContents
            Worksheets("A").Cells(i, "AV").ClearContents
        End If
    Next i
End Sub

'判断工作表是否存在的函数
Function WorksheetExists(shtName As String) As Boolean
    WorksheetExists = False
    On Error Resume Next
    WorksheetExists = (Worksheets(shtName).Name <> "")
End Function

在代码中，我们首先添加了一个判断语句，使用 `WorksheetExists` 函数判断工作表"A"是否存在，如果不存在，则弹出一个提示框，并使用 `Exit Sub` 语句退出 Sub。如果存在，则继续执行后面的代码。

需要注意的是，我们还需要在代码末尾添加一个名为 `WorksheetExists` 的函数，用于判断工作表是否存在。在函数中，我们使用了一个 `On Error Resume Next` 语句来忽略任何可能出现的错误，如果能够成功获取工作表的名称，则说明工作表存在，返回值为 `True`，否则返回 `False`。

优化提升以下代码速度：Sub 一键检查明细数据() On Error Resume Next Application.ScreenUpdating = False Dim ws As Worksheet Set ws = Worksheets("报表1") Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row Dim i As Long For i = 2 To lastRow Dim val As Double, judgeVal As String, v2 As Double, v3 As String val = CDbl(ws.Cells(i, 10).Value) judgeVal = CStr(ws.Cells(i, 11).Value) v2 = CDbl(ws.Cells(i, 12).Value) v3 = CStr(ws.Cells(i, 13).Value) If InStr(judgeVal, "-") > 0 Then Dim item() As String item = Split(judgeVal, "-") Dim firstVal As Double, secondVal As Double firstVal = CDbl(item(0)) secondVal = CDbl(item(1)) Dim item2() As String item2 = Split(v3, "-") Dim S1 As Double, S2 As Double S1 = CDbl(item2(0)) S2 = CDbl(item2(1)) If firstVal > val Or val > secondVal Then ws.Cells(i, 10).Font.Color = 255 ws.Cells(i, 9).Font.Color = 255 ws.Cells(i, 9).Value = ws.Cells(i, 10).Value Else ws.Cells(i, 10).Font.ColorIndex = xlAutomatic ws.Cells(i, 9).Font.ColorIndex = xlAutomatic ws.Cells(i, 9).Value = "" End If If S1 > v2 Or v2 > S2 Then ws.Cells(i, 12).Font.Color = 255 Else ws.Cells(i, 12).Font.ColorIndex = xlAutomatic End If If ws.Cells(i, 12).Value = ws.Cells(i, 13).Value Then ws.Cells(i, 12).Font.ColorIndex = xlAutomatic End If End If Next i ActiveWorkbook.RefreshAll Application.ScreenUpdating = True End Sub

以下是对代码进行优化的建议：

1. 在循环前将需要用到的变量提前声明和初始化，避免在循环中重复声明和初始化，提高代码执行效率。

2. 将字符串的比较操作 InStr() 替换为直接比较字符串，避免函数调用和字符串转换的开销。

3. 将字符串的分割操作 Split() 替换为直接取子串，避免函数调用和数组创建的开销。

4. 将多个判断条件合并为一个复合条件，避免重复判断和逻辑判断的开销。

5. 避免在循环中使用 Excel 自动刷新功能，可以在循环结束后再刷新整个工作簿。

下面是我对代码进行优化后的实现：

Sub 一键检查明细数据()
On Error Resume Next
Application.ScreenUpdating = False

Dim ws As Worksheet
Set ws = Worksheets("报表1")

Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

Dim i As Long
Dim val As Double, judgeVal As String, v2 As Double, v3 As String
Dim item() As String, firstVal As Double, secondVal As Double
Dim item2() As String, S1 As Double, S2 As Double

For i = 2 To lastRow
val = CDbl(ws.Cells(i, 10).Value)
judgeVal = ws.Cells(i, 11).Value
v2 = CDbl(ws.Cells(i, 12).Value)
v3 = ws.Cells(i, 13).Value

If judgeVal Like "*-*" Then
firstVal = CDbl(Left(judgeVal, InStr(judgeVal, "-") - 1))
secondVal = CDbl(Right(judgeVal, Len(judgeVal) - InStr(judgeVal, "-")))

If v3 Like "*-*" Then
S1 = CDbl(Left(v3, InStr(v3, "-") - 1))
S2 = CDbl(Right(v3, Len(v3) - InStr(v3, "-")))

If (val < firstVal Or val > secondVal) And (v2 < S1 Or v2 > S2) Then
ws.Cells(i, 9).Value = ws.Cells(i, 10).Value
ws.Cells(i, 9).Font.Color = 255
ws.Cells(i, 10).Font.Color = 255
ws.Cells(i, 12).Font.Color = 255
ElseIf val < firstVal Or val > secondVal Then
ws.Cells(i, 9).Value = ws.Cells(i, 10).Value
ws.Cells(i, 9).Font.Color = 255
ws.Cells(i, 10).Font.Color = 255
ws.Cells(i, 12).Font.ColorIndex = xlAutomatic
ElseIf v2 < S1 Or v2 > S2 Then
ws.Cells(i, 9).Value = ws.Cells(i, 10).Value
ws.Cells(i, 9).Font.Color = 255
ws.Cells(i, 10).Font.ColorIndex = xlAutomatic
ws.Cells(i, 12).Font.Color = 255
Else
ws.Cells(i, 9).Value = ""
ws.Cells(i, 9).Font.ColorIndex = xlAutomatic
ws.Cells(i, 10).Font.ColorIndex = xlAutomatic
ws.Cells(i, 12).Font.ColorIndex = xlAutomatic
End If
ElseIf val < firstVal Or val > secondVal Then
ws.Cells(i, 9).Value = ws.Cells(i, 10).Value
ws.Cells(i, 9).Font.Color = 255
ws.Cells(i, 10).Font.Color = 255
ws.Cells(i, 12).Font.ColorIndex = xlAutomatic
ElseIf v2 < CDbl(v3) Or v2 > CDbl(v3) Then
ws.Cells(i, 9).Value = ws.Cells(i, 10).Value
ws.Cells(i, 9).Font.Color = 255
ws.Cells(i, 10).Font.ColorIndex = xlAutomatic
ws.Cells(i, 12).Font.Color = 255
Else
ws.Cells(i, 9).Value = ""
ws.Cells(i, 9).Font.ColorIndex = xlAutomatic
ws.Cells(i, 10).Font.ColorIndex = xlAutomatic
ws.Cells(i, 12).Font.ColorIndex = xlAutomatic
End If
ElseIf v2 < CDbl(v3) Or v2 > CDbl(v3) Then
ws.Cells(i, 9).Value = ws.Cells(i, 10).Value
ws.Cells(i, 9).Font.Color = 255
ws.Cells(i, 10).Font.ColorIndex = xlAutomatic
ws.Cells(i, 12).Font.Color = 255
ElseIf ws.Cells(i, 12).Value = ws.Cells(i, 13).Value Then
ws.Cells(i, 12).Font.ColorIndex = xlAutomatic
Else
ws.Cells(i, 9).Value = ""
ws.Cells(i, 9).Font.ColorIndex = xlAutomatic
ws.Cells(i, 10).Font.ColorIndex = xlAutomatic
ws.Cells(i, 12).Font.ColorIndex = xlAutomatic
End If
Next i

ActiveWorkbook.RefreshAll
Application.ScreenUpdating = True
End Sub

希望对您有所帮助！