VBA代码问题：含TITER的记录同时输出至CI和Error工作表

你的问题很明确：当源数据的col列包含"TITER"时，记录被同时写入了CI和Error工作表。这是因为在处理完Error表的写入后，你没有跳过后续CI表的写入逻辑——原代码里，判断完TITER并写入Error后，程序会继续执行后面的CI写入代码，导致两条路径都走了。

我们需要调整逻辑：当检测到"TITER"时，只写入Error表，然后直接进入下一次循环，不执行CI表的写入。这里提供两种清晰的实现方式：

方式1：用Else分支分离逻辑 #

把CI表的写入代码放到TITER判断的Else分支里，这样只有当不满足TITER条件时，才会执行CI的写入，逻辑更直观：

Public lstrow As Long, strDate As Variant, stredate As Variant
Sub importbuild()
    lstrow = Worksheets("Data").Range("G" & Rows.Count).End(xlUp).Row
End Sub

Function DateOnlyLoad(col As String, col2 As String, colcode As String)
    Dim i As Long, j As Long, k As Long
    j = Worksheets("CI").Range("A" & Rows.Count).End(xlUp).Row + 1
    k = Worksheets("Error").Range("A" & Rows.Count).End(xlUp).Row + 1
    
    For i = 2 To lstrow
        strDate = spacedate(Worksheets("Data").Range(col & i).Value)
        stredate = spacedate(Worksheets("Data").Range(col2 & i).Value)
        
        If (Len(strDate) = 0 And (col2 = "NA" Or Len(stredate) = 0)) Or InStr(1, UCase(Worksheets("Data").Range(col & i).Value), "EXP") > 0 Then
            GoTo EmptyRange
        Else
            If InStr(1, UCase(Worksheets("Data").Range(col & i).Value), "TITER") > 0 Then
                ' 写入Error工作表
                Worksheets("Error").Range("A" & k & ":C" & k).Value = Worksheets("Data").Range("F" & i & ":H" & i).Value
                Worksheets("Error").Range("D" & k).Value = "REVIEW MMR1 DATES"
                k = k + 1
            Else
                ' 只有不满足TITER条件时，才写入CI工作表
                Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("F" & i & ":H" & i).Value
                Worksheets("CI").Range("D" & j).Value = colcode
                Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)
                Worksheets("CI").Range("L" & j).Value = dateclean(strDate)
                Worksheets("CI").Range("M" & j).Value = strDate
                
                If col2 <> "NA" Then
                    If IsEmpty(stredate) = False Then
                        Worksheets("CI").Range("F" & j).Value = datecleanup(stredate)
                    End If
                End If
                j = j + 1
            End If
        End If
EmptyRange:
    Next i
End Function

方式2：写入Error后直接跳转到循环末尾 #

如果不想大幅调整原有结构，也可以在写入Error后，用GoTo EmptyRange直接跳过CI的写入逻辑：

Public lstrow As Long, strDate As Variant, stredate As Variant
Sub importbuild()
    lstrow = Worksheets("Data").Range("G" & Rows.Count).End(xlUp).Row
End Sub

Function DateOnlyLoad(col As String, col2 As String, colcode As String)
    Dim i As Long, j As Long, k As Long
    j = Worksheets("CI").Range("A" & Rows.Count).End(xlUp).Row + 1
    k = Worksheets("Error").Range("A" & Rows.Count).End(xlUp).Row + 1
    
    For i = 2 To lstrow
        strDate = spacedate(Worksheets("Data").Range(col & i).Value)
        stredate = spacedate(Worksheets("Data").Range(col2 & i).Value)
        
        If (Len(strDate) = 0 And (col2 = "NA" Or Len(stredate) = 0)) Or InStr(1, UCase(Worksheets("Data").Range(col & i).Value), "EXP") > 0 Then
            GoTo EmptyRange
        Else
            If InStr(1, UCase(Worksheets("Data").Range(col & i).Value), "TITER") > 0 Then
                Worksheets("Error").Range("A" & k & ":C" & k).Value = Worksheets("Data").Range("F" & i & ":H" & i).Value
                Worksheets("Error").Range("D" & k).Value = "REVIEW MMR1 DATES"
                k = k + 1
                ' 直接跳转到循环末尾，跳过CI的写入
                GoTo EmptyRange
            End If
            
            ' 只有不满足TITER条件时，才会执行这里的CI写入
            Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("F" & i & ":H" & i).Value
            Worksheets("CI").Range("D" & j).Value = colcode
            Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)
            Worksheets("CI").Range("L" & j).Value = dateclean(strDate)
            Worksheets("CI").Range("M" & j).Value = strDate
            
            If col2 <> "NA" Then
                If IsEmpty(stredate) = False Then
                    Worksheets("CI").Range("F" & j).Value = datecleanup(stredate)
                End If
            End If
            j = j + 1
        End If
EmptyRange:
    Next i
End Function

• 尽量避免过多使用GoTo，虽然这里用来跳过循环逻辑没问题，但过度使用会让代码可读性变差（方式1的分支结构更推荐）。
• 可以把常用工作表赋值给变量，比如Dim wsData As Worksheet: Set wsData = Worksheets("Data")，这样代码更简洁，也能减少重复引用的开销。

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