如何用VBA实现非连续单元格条件复制：跳过NR与已有数据

我需要实现两个核心需求：

• 不复制源工作表中值为NR的单元格
• 不覆盖目标工作表中已有数据的单元格

原始代码每日运行，但目标工作表每月会有一天产生需要保留的有效数据，原始代码会先用NR覆盖这些有效数据，再删除NR导致单元格空白，且需处理的是非连续单元格，原始代码如下：

wsElog2.Range("E60") = wseDNA2.Range("DE15") 'Filtered Effluent Calcium
wsElog2.Range("E61") = wseDNA2.Range("DO15") 'Filtered Effluent Magnesium
wsElog2.Range("E64") = wseDNA2.Range("EA15") 'Filtered Effluent Potassium
wsElog2.Range("E62") = wseDNA2.Range("EE15") 'Filtered Effluent Sodium


'Lagoons 1
wsElog2.Range("G55") = wseDNA2.Range("EU15") 'Ammonia
wsElog2.Range("G48") = wseDNA2.Range("EW15") 'Blue Green Algae
wsElog2.Range("G52") = wseDNA2.Range("EY15") 'E. coli
wsElog2.Range("G59") = wseDNA2.Range("FA15") 'EC
wsElog2.Range("G54") = wseDNA2.Range("FC15") 'Nitrate
wsElog2.Range("G53") = wseDNA2.Range("FE15") 'Nitrite
wsElog2.Range("G57") = wseDNA2.Range("FG15") 'TN
wsElog2.Range("G58") = wseDNA2.Range("FI15") 'pH
wsElog2.Range("G56") = wseDNA2.Range("FK15") 'TP

For Each c In wsElog2.Range("B1:L159")
    If c.Text = "NR" Then
        c.Value = ""
    End If
Next

解决方案 #

通过将源和目标单元格地址存入数组，循环遍历并添加双重判断逻辑，解决了非连续单元格的处理问题，修改后的完整代码如下（已移除未启用的DEBUG_PRINT部分）：

Sub CopyCellValues()
    
    ' 将源和目标单元格地址存入数组，按对应顺序排列
    Dim SourceCells() As Variant: SourceCells = Array("DE15", "DO15", "EA15", "EE15", _
                                                      "EU15", "EW15", "EY15", "FA15", _
                                                      "FC15", "FE15", "FG15", "FI15", "FK15")
    Dim TargetCells() As Variant: TargetCells = Array("E60", "E61", "E64", "E62", _
                                                      "G55", "G48", "G52", "G59", _
                                                      "G54", "G53", "G57", "G58", "G56")
    
    ' 此处添加工作表定义代码，例如：
    ' Dim wsElog2 As Worksheet, wseDNA2 As Worksheet
    ' Set wsElog2 = ThisWorkbook.Worksheets("目标表名")
    ' Set wseDNA2 = ThisWorkbook.Worksheets("源表名")
    
    Dim sVal As Variant, n As Long, IsSourceValid As Boolean
    
    For n = LBound(SourceCells) To UBound(SourceCells)
        With wsElog2.Range(TargetCells(n))
            IsSourceValid = False ' 每次循环重置标记
            ' 第一步：判断目标单元格是否为空，避免覆盖已有数据
            If Len(CStr(.Value)) = 0 Then
                ' 第二步：验证源单元格值是否有效
                sVal = wseDNA2.Range(SourceCells(n)).Value
                If Not IsError(sVal) Then ' 排除错误值
                    If Len(sVal) > 0 Then ' 排除空值
                        If StrComp(sVal, "NR", vbTextCompare) <> 0 Then ' 排除"NR"
                            IsSourceValid = True
                        End If
                    End If
                End If
            End If
            
            ' 仅当目标为空且源有效时执行复制
            If IsSourceValid = True Then
                .Value = sVal
            End If
        End With
    Next n

End Sub

核心逻辑说明 #

1. 非连续单元格处理：用两个数组分别存储源和目标单元格地址，保证每一组单元格一一对应，通过循环遍历数组实现非连续单元格的批量处理。
2. 双重判断机制：
   • 先检查目标单元格是否为空，严格避免覆盖已有有效数据
   • 再验证源单元格值：依次排除错误值、空值和NR，仅复制符合要求的有效数据
3. 标记重置：每次循环重置IsSourceValid标记，避免前一次的判断结果干扰当前循环

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