Excel VBA：循环收集周日对应单元格地址并生成求和公式求助

原代码的问题在于第二个循环中，每次找到符合条件的单元格时会直接覆盖addr变量，且每次循环都对AK4赋值，最终仅保留最后一个匹配的单元格地址。要实现收集所有符合条件的地址并生成求和公式，只需修改第二个循环的逻辑，通过字符串拼接累积所有目标地址，循环结束后再设置公式。

修改后的完整代码：

Sub ercan()

Dim ws As Worksheet
Set ws = Worksheets("Sayfa1")
Dim addr As String ' 初始化空字符串用于累积地址

' 第一部分：设置周末单元格背景色，保留原逻辑
For Each gunadi In ws.Range("D1:AH1")
    If gunadi.Text = "CUMARTESİ" Then ' CUMARTESİ = 周六
        gunadi.Interior.Color = RGB(146, 208, 80)
        gunadi.Offset(1, 0).Interior.Color = RGB(146, 208, 80)
    ElseIf gunadi.Text = "PAZAR" Then ' PAZAR = 周日
        gunadi.Interior.Color = RGB(0, 176, 80)
        gunadi.Offset(1, 0).Interior.Color = RGB(0, 176, 80)
    Else
        gunadi.Interior.ColorIndex = 0
        gunadi.Offset(1, 0).Interior.ColorIndex = 0
    End If
Next

' 第二部分：收集所有符合条件的单元格地址并生成求和公式
addr = "" ' 初始化为空
For Each haftaici In ws.Range("D4:AH4")
    If haftaici.Offset(-3, 0).Text = "PAZAR" Then
        ' 如果addr已有内容，先添加加号，再拼接新地址；否则直接赋值
        If addr <> "" Then
            addr = addr & "+" & haftaici.Address(False, False)
        Else
            addr = haftaici.Address(False, False)
        End If
    End If
Next

' 循环结束后统一设置求和公式
If addr <> "" Then ' 确保有匹配的地址时才设置公式
    ws.Range("AK4").Formula = "=" & addr
Else
    ws.Range("AK4").Value = "" ' 无匹配时清空单元格
End If

End Sub

关键改动说明： #

• 提前初始化addr字符串变量，用于累积所有符合条件的单元格地址
• 循环内通过判断addr是否为空，决定直接赋值还是添加加号后拼接新地址
• 循环结束后再一次性给AK4设置公式，避免每次循环覆盖内容
• 增加了无匹配地址时的处理，清空AK4内容避免错误

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