如何用动态VBA代码在满足三条件时向D列写入指定文本？

针对你需要在满足「A列不为空、B列包含“yes”、C列不为空」时，给对应D列单元格写入“text”的需求，结合数千行数据的场景，提供两种高效动态实现方案：

方案一：利用AutoFilter筛选后批量写入 #

这种方法适合习惯用筛选操作的场景，筛选出符合条件的行后批量赋值，代码执行效率较高：

Sub WriteTextWithFilter()
    Dim sourceSheet As Worksheet
    Dim lastRow As Long
    Dim targetRange As Range
    
    ' 设置目标工作表（根据实际情况修改）
    Set sourceSheet = ThisWorkbook.Sheets("你的工作表名")
    
    ' 关闭屏幕更新、禁用事件，提升运行速度
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    On Error GoTo Cleanup ' 错误处理
    
    ' 动态获取数据最后一行（以A列为准，确保覆盖所有数据）
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    
    ' 清除之前的筛选
    If sourceSheet.AutoFilterMode Then sourceSheet.AutoFilterMode = False
    
    ' 应用多条件筛选：A列非空、B列包含yes、C列非空
    With sourceSheet.Range("A1:C" & lastRow)
        .AutoFilter Field:=1, Criteria1:="<>" ' A列不为空
        .AutoFilter Field:=2, Criteria1:="*yes*", Operator:=xlAnd ' B列包含yes（不区分大小写）
        .AutoFilter Field:=3, Criteria1:="<>" ' C列不为空
    End With
    
    ' 定位筛选后的可见单元格（排除表头行）
    On Error Resume Next ' 处理无符合条件行的情况
    Set targetRange = sourceSheet.Range("D2:D" & lastRow).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' 批量写入text
    If Not targetRange Is Nothing Then
        targetRange.Value = "text"
    End If
    
Cleanup:
    ' 恢复筛选、屏幕更新和事件
    If sourceSheet.AutoFilterMode Then sourceSheet.AutoFilterMode = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    If Err.Number <> 0 Then
        MsgBox "执行出错：" & Err.Description, vbExclamation
    End If
End Sub

方案二：数组批量处理（更适合大数据量） #

对于数千行数据，数组操作比单元格遍历快得多，直接在内存中处理数据：

Sub WriteTextWithArray()
    Dim sourceSheet As Worksheet
    Dim lastRow As Long
    Dim dataArr As Variant
    Dim i As Long
    
    Set sourceSheet = ThisWorkbook.Sheets("你的工作表名")
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    On Error GoTo Cleanup
    
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    ' 将A-C列数据读入数组
    dataArr = sourceSheet.Range("A1:C" & lastRow).Value
    
    ' 遍历数组判断条件，直接写入D列
    For i = 2 To UBound(dataArr) ' 从第2行开始（跳过表头）
        ' 判断条件：A列非空、B列包含yes、C列非空
        If dataArr(i, 1) <> "" _
            And InStr(1, UCase(dataArr(i, 2)), "YES") > 0 _
            And dataArr(i, 3) <> "" Then
            sourceSheet.Cells(i, "D").Value = "text"
        End If
    Next i
    
Cleanup:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    If Err.Number <> 0 Then
        MsgBox "执行出错：" & Err.Description, vbExclamation
    End If
End Sub

关键建议 #

• 效率优化：始终开启ScreenUpdating = False和EnableEvents = False，避免频繁刷新屏幕和触发不必要的事件，大幅提升运行速度。
• 动态行号：用Cells(Rows.Count, "A").End(xlUp).Row获取最后一行，避免硬编码行号，适配数据量变化。
• 大小写处理：如果需要区分“yes”的大小写，把UCase(dataArr(i, 2))去掉即可；不区分的话用UCase统一转大写后判断更稳妥。
• 错误处理：添加错误捕获，避免代码崩溃，同时给出明确的错误提示。
• 测试建议：先在小范围数据上测试代码，确认逻辑正确后再全量运行，防止误修改数据。

内容的提问来源于stack exchange，提问作者little turtle