为什么我的宏不能用于替换文本?

问题描述 投票:0回答:1

有人可以告诉我为什么下面的代码不起作用。这就是我想要的。

如果 D 列中的单元格显示 emilio pucci 或 max mara 或 tom ford,并且如果在同一行的 H 列中看到单词“太阳镜”,则将 E 列单元格中的内容替换为 Marcolin,如果它显示 gucci 或 saint laurent或 balenciaga,如果在 H 列中看到“太阳镜”一词,则将 E 列单元格中的内容替换为 Kering

示例:D3 有 Emilio Pucci,在 H3 中表示太阳镜,然后在 E3 中替换 Marcolin 中的内容。

现在它什么也没做。

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
excel vba text replace
1个回答
0
投票

这是一种可能性:

Sub ReplaceBrandNames()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim brandName As String
    
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name
    lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
    
    ' Loop through each row in column D
    For i = 2 To lastRow
        If HasText(ws.Cells(i, "H").Value, "sunglasses") Then
            brandName = ws.Cells(i, "D").Value
            If HasText(brandName, "emilio pucci", "max mara", "tom ford", _
                       "roberto cavalli", "bally", "max mara", "moncler") Then
                ws.Cells(i, "E").Value = "Marcolin"
            End If
            If HasText(brandName, "gucci", "saint laurent", "balenciaga", _
                      "stella mccartney", "reike nen", "Alaïa", "courreges", _
                      "bottega veneta", "tomas maier", "mcq alexander mcqueen") Then
                ws.Cells(i, "E").Value = "Marcolin"
            End If
            If HasText(brandName, "isabel marant", "carrera", "givenchy", "rag & bone", "dior", "fendi") Then
                ws.Cells(i, "E").Value = "Safilo Group"
            End If
        End If
    Next i
    MsgBox "Replace Text Completed"
End Sub

'Does the string `s` contain any of the one or more values
'  passed to `texts`?
Function HasText(s As String, ParamArray texts()) As Boolean
    Dim txt
    For Each txt In texts
        If InStr(1, s, txt, vbTextCompare) > 0 Then
            HasText = True
            Exit Function
        End If
    Next txt
End Function
© www.soinside.com 2019 - 2024. All rights reserved.