VBA编译错误‘End With without With’排查解决请求

Hey there! Let's tackle that frustrating "End With without With" error you're hitting—it's almost always about mismatched block statements, and that's exactly what's going on here.

核心问题：未闭合的If语句 #

你写了一连串针对departmentHead(n)的判断，但每个If都没有对应的End If。编译器无法识别With块的正确范围，最后看到End With时找不到它对应的起始With语句，直接抛出编译错误。

第一步：修复If语句结构 #

把连续的独立If改成ElseIf（逻辑更高效，也减少嵌套层级），并且在最后一个判断后加上End If闭合整个条件块。示例如下：

If departmentHead(n) = "Name1" Then
    .Cells(14, 7).Value = "VIO"
    .Cells(31, 7).Value = "VIO"
    .Cells(31, 4).Value = departmentHead(n)
ElseIf departmentHead(n) = "Name2" Then
    .Cells(14, 7).Value = "ITO"
    .Cells(31, 7).Value = "ITO"
    .Cells(31, 4).Value = departmentHead(n)
' ... 依次添加其他Name的ElseIf判断 ...
ElseIf departmentHead(n) = "Name10" Then
    .Cells(14, 7).Value = "ABO"
    .Cells(31, 7).Value = "ABO"
    .Cells(31, 4).Value = departmentHead(n)
Else
    .Cells(14, 7).Value = ""
    .Cells(31, 7).Value = ""
    .Cells(31, 4).Value = ""
    '.Cells(31, 4).Value = supervisorName(n)
    '.Cells(31, 7).Value = supervisorDepartment(n)
    .Cells(33, 4).Value = "Name0"
End If ' 必须加上这行，闭合整个条件块

第二步：优化其他冗余/错误代码 #

除了编译错误，你的代码还有几个可以改进的点：

• 冗余的Workbook赋值：你先通过Set outXl = xlApp.Workbooks.Open(strTemplate, True)获取了打开的工作簿对象，紧接着又Set outXl = ActiveWorkbook，这完全没必要，直接保留第一个赋值即可，避免依赖ActiveWorkbook带来的潜在问题。
• Do While循环逻辑错误：原代码中Do While (i < (12 - reviewersCount))条件不合理，你应该是要填充到第12个 reviewer 位置，所以条件改为i < 12；另外，引用拆分数组时用ETO_reviewers(i)是错误的，需要单独维护每个拆分数组的索引（比如用j），否则会引用到错误的数组元素。
• 变量声明规范：把所有Dim语句移到代码块开头，符合VBA最佳实践，代码可读性更强。

修复后的完整代码片段 #

*2/B. - Generate template based new excel file and fill up cells with data of document attributes*
For n = 1 To documentCount
    Dim strTemplate As String: strTemplate = "C:\Users\C3642\Desktop\FU5504-Elfogadhatosagi_Nyilatkozat_formanyomtatvany\PA2-FU-5504-NY-01_v2.xlsx"
    Dim outXl As Workbook
    Set outXl = xlApp.Workbooks.Open(strTemplate, True)
    ' 移除冗余的Set outXl = ActiveWorkbook
    
    ' 集中声明所有变量
    Dim innerReviewers() As String, split_ETO_reviewers() As String, split_KGO_reviewers() As String
    Dim split_PGO_reviewers() As String, split_NUO_reviewers() As String, split_AMO_reviewers() As String
    Dim split_VSKO_reviewers() As String, split_VIO_reviewers() As String, split_ABO_reviewers() As String
    Dim split_ITO_reviewers() As String, split_UIG_reviewers() As String, split_ENBO_reviewers() As String
    Dim split_LETO_reviewers() As String, split_Non_ERBE_reviewers() As String, split_ERBE_reviewers() As String
    Dim reviewersCount As Integer, i As Integer, j As Integer
    
    With outXl.Worksheets(1)
        .SaveAs Filename:="C:\Users\C3642\Desktop\FU5504-Elfogadhatosagi_Nyilatkozat_formanyomtatvany\" & docCode(n) & "_" & docResponsible(n) & ".xlsx", FileFormat:=xlOpenXMLWorkbookMacroEnabled
        .Cells(5, 4).Value = docName(n)
        .Cells(6, 4).Value = docCode(n)
        '.Cells(6, 13).Value = docRevision(n) <- nincs hozzá adat :(
        .Cells(14, 4).Value = docResponsible(n)
        
        ' 修复If-ElseIf结构，添加End If
        If departmentHead(n) = "Name1" Then
            .Cells(14, 7).Value = "VIO"
            .Cells(31, 7).Value = "VIO"
            .Cells(31, 4).Value = departmentHead(n)
        ElseIf departmentHead(n) = "Name2" Then
            .Cells(14, 7).Value = "ITO"
            .Cells(31, 7).Value = "ITO"
            .Cells(31, 4).Value = departmentHead(n)
        ElseIf departmentHead(n) = "Name3" Then
            .Cells(14, 7).Value = "VSKO"
            .Cells(31, 7).Value = "VSKO"
            .Cells(31, 4).Value = departmentHead(n)
        ElseIf departmentHead(n) = "Name4" Then
            .Cells(14, 7).Value = "AMO"
            .Cells(31, 7).Value = "AMO"
            .Cells(31, 4).Value = departmentHead(n)
        ElseIf departmentHead(n) = "Name5" Then
            .Cells(14, 7).Value = "NUO"
            .Cells(31, 7).Value = "NUO"
            .Cells(31, 4).Value = departmentHead(n)
        ElseIf departmentHead(n) = "Name6" Then
            .Cells(14, 7).Value = "KGO"
            .Cells(31, 7).Value = "KGO"
            .Cells(31, 4).Value = departmentHead(n)
        ElseIf departmentHead(n) = "Name7" Then
            .Cells(14, 7).Value = "PGO"
            .Cells(31, 7).Value = "PGO"
            .Cells(31, 4).Value = departmentHead(n)
        ElseIf departmentHead(n) = "Name8" Then
            .Cells(14, 7).Value = "ETO"
            .Cells(31, 7).Value = "ETO"
            .Cells(31, 4).Value = departmentHead(n)
        ElseIf departmentHead(n) = "Name9" Then
            .Cells(14, 7).Value = "GMDO"
            .Cells(31, 7).Value = "GMDO"
            .Cells(31, 4).Value = departmentHead(n)
        ElseIf departmentHead(n) = "Name10" Then
            .Cells(14, 7).Value = "ABO"
            .Cells(31, 7).Value = "ABO"
            .Cells(31, 4).Value = departmentHead(n)
        Else
            .Cells(14, 7).Value = ""
            .Cells(31, 7).Value = ""
            .Cells(31, 4).Value = ""
            '.Cells(31, 4).Value = supervisorName(n)
            '.Cells(31, 7).Value = supervisorDepartment(n)
            .Cells(33, 4).Value = "Name0"
        End If ' 闭合条件块
        
        innerReviewers() = Split(reviewers(n), ",")
        split_ETO_reviewers() = Split(ETO_reviewers(n), ",")
        split_KGO_reviewers() = Split(KGO_reviewers(n), ",")
        split_PGO_reviewers() = Split(PGO_reviewers(n), ",")
        split_NUO_reviewers() = Split(NUO_reviewers(n), ",")
        split_AMO_reviewers() = Split(AMO_reviewers(n), ",")
        split_VSKO_reviewers() = Split(VSKO_reviewers(n), ",")
        split_VIO_reviewers() = Split(VIO_reviewers(n), ",")
        split_ABO_reviewers() = Split(ABO_reviewers(n), ",")
        split_ITO_reviewers() = Split(ITO_reviewers(n), ",")
        split_UIG_reviewers() = Split(UIG_reviewers(n), ",")
        split_ENBO_reviewers() = Split(ENBO_reviewers(n), ",")
        split_LETO_reviewers() = Split(LETO_reviewers(n), ",")
        split_Non_ERBE_reviewers() = Split(Non_ERBE_reviewers(n), ",")
        split_ERBE_reviewers() = Split(ERBE_reviewers(n), ",")
        
        reviewersCount = 0
        ' 修复逻辑判断，用And代替&
        If (IsEmpty(innerReviewers) And IsEmpty(split_ETO_reviewers) And IsEmpty(split_KGO_reviewers) And IsEmpty(split_PGO_reviewers) And IsEmpty(split_NUO_reviewers) And IsEmpty(split_AMO_reviewers) And IsEmpty(split_VSKO_reviewers) And IsEmpty(split_VIO_reviewers) And IsEmpty(split_ABO_reviewers) And IsEmpty(split_ITO_reviewers)) Then
            MsgBox "The current document has not been reviewed by colleques! (Archiving function of list of non-reviewed docs is not ready.)", vbOKOnly, "Warning for lacking reviewers!"
        Else
            ' 处理innerReviewers
            reviewersCount = UBound(innerReviewers) - LBound(innerReviewers) + 1
            i = 0
            Do While i < reviewersCount And i < 12
                .Cells(15 + i, 4).Value = innerReviewers(i)
                i = i + 1
            Loop
            
            ' 处理split_ETO_reviewers，用j维护数组索引
            j = 0
            Do While i < 12 And j <= UBound(split_ETO_reviewers)
                .Cells(15 + i, 4).Value = split_ETO_reviewers(j)
                i = i + 1
                j = j + 1
            Loop
            
            ' 其他拆分数组的处理按照上述逻辑修改即可
            ' ... 省略其他Do While块 ...
        End If
    End With ' 现在这个End With能正确匹配开头的With了
    
    outXl.Close SaveChanges:=True
Next n

最后确认 #

修复完If语句的End If之后，那个“End With without With”的编译错误就会消失。另外，记得确认xlApp已经正确初始化（比如Set xlApp = New Excel.Application），不过你提到已经声明，应该没问题。

内容的提问来源于stack exchange，提问作者Blatt Kristófi