看起来你已经找对了方向（用循环简化冗长的单元格拼接），但问题出在字符串拼接的逻辑上——你每次循环都直接覆盖了strsql变量，而不是把新行的内容追加进去，最后自然只保留了循环的最后一行内容。让我一步步帮你修复并优化这段代码：

基础修复：修正循环拼接逻辑 #

首先解决核心问题，把赋值改成追加，同时抽离重复的连接刷新逻辑，避免代码冗余：

Sub Custom_Query()
    Dim strsql As String
    Dim i As Integer ' 显式声明循环变量，避免隐式类型转换问题
    
    ' 处理Dog + Food_Consumption的情况
    If Worksheets("Animal_Entry").Range("B1") = "Dog" And Worksheets("Animal_Entry").Range("E1") = "Food_Consumption" Then
        strsql = "" ' 先初始化空字符串
        For i = 362 To 366
            ' 用 & 追加内容，而不是直接赋值覆盖
            strsql = strsql & Worksheets("Custom_Queries").Range("A" & i) & vbNewLine
        Next i
        ' 调用抽离的刷新子过程
        RefreshCustomQuery strsql
    ' 处理Dog + Bathroom_Breaks的情况
    ElseIf Worksheets("Animal_Entry").Range("B1") = "Dog" And Worksheets("Animal_Entry").Range("E1") = "Bathroom_Breaks" Then
        strsql = ""
        For i = 372 To 376
            strsql = strsql & Worksheets("Custom_Queries").Range("A" & i) & vbNewLine
        Next i
        RefreshCustomQuery strsql
    End If
End Sub

' 把重复的连接刷新逻辑抽成独立子过程，方便复用
Sub RefreshCustomQuery(sqlText As String)
    With ActiveWorkbook.Connections("Custom_Query").ODBCConnection
        .BackgroundQuery = True
        Debug.Print sqlText ' 调试用，可保留或删除
        .CommandText = sqlText
    End With
    ActiveWorkbook.Connections("Custom_Query").Refresh
End Sub

进阶优化：用字典映射简化扩展 #

如果后续要新增更多动物类型或报表选项，If-Else分支会越来越臃肿。推荐用字典映射来管理查询的行范围，让代码更易维护，效率也更高：

Sub Custom_Query_Advanced()
    Dim strsql As String
    Dim queryKey As String
    Dim queryMap As Object
    
    ' 创建字典，键是「动物类型_报表类型」的组合，值是对应的SQL行范围
    Set queryMap = CreateObject("Scripting.Dictionary")
    queryMap.Add "Dog_Food_Consumption", "A362:A366"
    queryMap.Add "Dog_Bathroom_Breaks", "A372:A376"
    ' 以后新增查询，直接在这里加一行即可，不用改其他逻辑
    
    ' 生成当前选择的查询键
    queryKey = Worksheets("Animal_Entry").Range("B1") & "_" & Worksheets("Animal_Entry").Range("E1")
    
    ' 检查是否有对应的查询模板，避免报错
    If queryMap.Exists(queryKey) Then
        ' 用Join函数直接拼接整个范围的内容，比循环每个单元格高效得多
        strsql = Join(Worksheets("Custom_Queries").Range(queryMap(queryKey)).Value, vbNewLine)
        RefreshCustomQuery strsql
    Else
        MsgBox "未找到对应的查询模板，请检查选择的选项！", vbExclamation
    End If
End Sub

' 复用之前的刷新子过程
Sub RefreshCustomQuery(sqlText As String)
    With ActiveWorkbook.Connections("Custom_Query").ODBCConnection
        .BackgroundQuery = True
        Debug.Print sqlText
        .CommandText = sqlText
    End With
    ActiveWorkbook.Connections("Custom_Query").Refresh
End Sub

优化亮点 #

• 效率提升：用Join结合单元格区域的Value数组，避免了逐单元格循环的开销，尤其是SQL行数较多时效果明显。
• 可维护性：新增查询只需在字典里添加键值对，不用修改大量分支逻辑。
• 错误防护：增加了键存在性检查，避免用户选择未配置的选项导致代码崩溃。

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