Excel VBA脚本无效果：同行单元格条件替换列值需求排查

需求说明 #

• 当同一行D列单元格包含emilio pucci、max mara、tom ford等品牌，且H列包含sunglasses时，将E列替换为Marcolin
• 当D列单元格包含gucci、saint laurent、balenciaga等品牌，且H列包含sunglasses时，将E列替换为Kering
• 满足H列sunglasses条件的其他品牌，E列统一替换为Safilo Group

示例：D3为Emilio Pucci且H3含sunglasses时，E3替换为Marcolin

问题描述 #

编写的ReplaceBrandNames VBA脚本执行后无任何实际替换效果，仅弹出"Replace Text Completed"提示框。

原代码 #

Sub ReplaceBrandNames()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim brandName As String
    
    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name
    
    ' Find the last row in column D
    lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
    
    ' Loop through each row in column D
    For i = 2 To lastRow
        ' Check if the cell in column D contains one of the specified brand names
        brandName = ws.Cells(i, "D").Value
        If brandName = "emilio pucci" Or brandName = "max mara" Or brandName = "tom ford" Or brandName = "roberto cavalli" Or brandName = "bally" Or brandName = "max mara" Or brandName = "moncler" Then
            ' Check if the corresponding cell in column H contains the word "sunglasses"
            If InStr(1, ws.Cells(i, "H").Value, "sunglasses", vbTextCompare) > 0 Then
                ' Replace the value in column E with "Marcolin"
                ws.Cells(i, "E").Value = "Marcolin"
            End If
        ElseIf brandName = "gucci" Or brandName = "saint laurent" Or brandName = "balenciaga" Or brandName = "stella mccartney" Or brandName = "reike nen" Or brandName = "Alaïa" Or brandName = "courreges" Or brandName = "bottega veneta" Or brandName = "tomas maier" Or brandName = "mcq alexander mcqueen" Then
            ' Check if the corresponding cell in column H contains the word "sunglasses"
            If InStr(1, ws.Cells(i, "H").Value, "sunglasses", vbTextCompare) > 0 Then
                ' Replace the value in column E with "Kering"
                ws.Cells(i, "E").Value = "Kering"
            End If
        ElseIf brandName = "isabel marant" Or brandName = "carrera" Or brandName = "givenchy" Or brandName = "rag & bone" Or brandName = "dior" Or brandName = "fendi" Then
            ' Check if the corresponding cell in column H contains the word "sunglasses"
            If InStr(1, ws.Cells(i, "H").Value, "sunglasses", vbTextCompare) > 0 Then
                ' Replace the value in column E with "Safilo Group"
                ws.Cells(i, "E").Value = "Safilo Group"
            End If
        End If
    Next i
    MsgBox "Replace Text Completed"
End Sub

问题根源 #

1. 精确匹配不符合需求：原代码使用brandName = "xxx"做精确相等判断，但需求是D列包含品牌名，若单元格内容是带后缀的品牌（如Emilio Pucci Eyewear）或大小写不一致（如Emilio Pucci），则无法匹配
2. 品牌判断逻辑错误：原代码中Safilo Group仅匹配指定的几个品牌，而非需求中的"其他品牌"
3. 冗余代码：max mara在Marcolin品牌组中重复出现，虽不影响逻辑但降低可读性

修复后的代码 #

Sub ReplaceBrandNames()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim dValue As String
    ' 定义品牌组数组，便于维护
    Dim marcolinBrands As Variant, keringBrands As Variant
    marcolinBrands = Array("emilio pucci", "max mara", "tom ford", "roberto cavalli", "bally", "moncler")
    keringBrands = Array("gucci", "saint laurent", "balenciaga", "stella mccartney", "reike nen", "alaïa", "courreges", "bottega veneta", "tomas maier", "mcq alexander mcqueen")
    
    ' 确认工作表名称正确
    Set ws = ThisWorkbook.Sheets("Sheet1")
    ' 获取D列最后一行数据
    lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
    
    For i = 2 To lastRow
        dValue = LCase(ws.Cells(i, "D").Value) ' 统一转为小写，避免大小写差异
        
        ' 先判断H列是否包含sunglasses，减少不必要的品牌检查
        If InStr(1, ws.Cells(i, "H").Value, "sunglasses", vbTextCompare) > 0 Then
            Dim brand As Variant
            Dim isMarcolin As Boolean, isKering As Boolean
            isMarcolin = False
            isKering = False
            
            ' 检查是否属于Marcolin品牌组
            For Each brand In marcolinBrands
                If InStr(1, dValue, brand) > 0 Then
                    isMarcolin = True
                    Exit For
                End If
            Next brand
            
            ' 若不属于Marcolin，检查是否属于Kering品牌组
            If Not isMarcolin Then
                For Each brand In keringBrands
                    If InStr(1, dValue, brand) > 0 Then
                        isKering = True
                        Exit For
                    End If
                Next brand
            End If
            
            ' 根据判断结果赋值E列
            Select Case True
                Case isMarcolin
                    ws.Cells(i, "E").Value = "Marcolin"
                Case isKering
                    ws.Cells(i, "E").Value = "Kering"
                Case Else
                    ws.Cells(i, "E").Value = "Safilo Group"
            End Select
        End If
    Next i
    MsgBox "替换完成"
End Sub

修复要点 #

• 改用包含匹配：使用InStr函数判断D列单元格是否包含品牌名，而非精确相等
• 统一大小写：将D列值转为小写，避免因大小写差异导致的匹配失败
• 品牌组数组化：将品牌列表存入数组，便于后续添加或修改品牌
• 优化逻辑顺序：先判断H列条件，减少不必要的品牌遍历
• 实现"其他品牌"逻辑：只要H列符合条件，不属于前两组的品牌统一替换为Safilo Group

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