如何在CK列可见单元格批量应用公式且不影响隐藏行（含空行处理）

核心思路 #

直接操作可见单元格范围，摒弃易出错的Select/Activate操作，同时覆盖无数据的边界场景：

替换后的完整代码 #

Dim ws As Worksheet
Dim firstVisibleRow As Long
Dim lastVisibleRow As Long
Dim visibleRange As Range

Set ws = ActiveSheet
' 执行你的筛选逻辑
ws.Range("$A$1").AutoFilter Field:=89, Criteria1:="0"

' 定位表头下第一个可见行
On Error Resume Next
firstVisibleRow = ws.Range("CK2:CK" & ws.Rows.Count).SpecialCells(xlCellTypeVisible).Row
On Error GoTo 0

' 定位数据区域最后一行
lastVisibleRow = ws.Cells(ws.Rows.Count, "CK").End(xlUp).Row

' 定义仅包含可见行的范围
If firstVisibleRow > 0 Then
    Set visibleRange = ws.Range("CK" & firstVisibleRow & ":CK" & lastVisibleRow).SpecialCells(xlCellTypeVisible)
End If

' 填充公式到所有可见行
If Not visibleRange Is Nothing Then
    visibleRange.Formula2R1C1 = _
        "=IFS(AND(LEN(RC[1])=18,LEFT(RC[1],2)=""1Z""), ""UPS"", " & _
        "AND(LEN(RC[1])=12,ISNUMBER(RC[1])),""FedEx""," & _
        "AND(LEN(RC[1])=10,ISNUMBER(RC[1])),""DHL""," & _
        "AND(LEN(RC[1])=11,LEFT(RC[1],2)=""06""), ""OTHER"", TRUE, """")"
Else
    ' 无可见数据时，仅在表头下第一空白行写入公式
    If IsEmpty(ws.Range("CK2")) Then
        ws.Range("CK2").Formula2R1C1 = _
            "=IFS(AND(LEN(RC[1])=18,LEFT(RC[1],2)=""1Z""), ""UPS"", " & _
            "AND(LEN(RC[1])=12,ISNUMBER(RC[1])),""FedEx""," & _
            "AND(LEN(RC[1])=10,ISNUMBER(RC[1])),""DHL""," & _
            "AND(LEN(RC[1])=11,LEFT(RC[1],2)=""06""), ""OTHER"", TRUE, """")"
    End If
End If

关键说明 #

• 跳过隐藏行：通过SpecialCells(xlCellTypeVisible)精准定位筛选后显示的行，公式只会写入可见单元格，完全不影响隐藏行。
• 无数据处理：当筛选后没有匹配数据时，自动检查表头下第一行（CK2），为空则写入公式。
• 补全公式逻辑：原公式未完成，代码补充了IFS的默认返回值（空字符串），可根据实际需求修改最后一个条件的返回内容。

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