Я получаю дубликат из цикла, который добавляет комментарии к ячейкам в VBA

Question

У меня есть две группы кода. первый работает замечательно и применяет правильные комментарии без дубликатов:

Dim rngCell As Range
Dim strComment As String, strConsolidated As String, strPerson As String, strConcat As String
Dim arrConcat() As String
Dim lngPos As Long

Dim WIPDATA As Worksheet
Dim Display As Worksheet
Set WIPDATA = Worksheets("WIPDATA")
Set Display = Worksheets("Display")

For Each rngCell In WIPDATA.Range("A2:A800")
    strConcat = strConcat & rngCell.Offset(0, 15) & rngCell & "||"
Next rngCell

arrConcat = Split(strConcat, "||")

For Each rngCell In Display.Range("D4:F25, H4:K25, Q4:R25")
    If rngCell.Value >= 0 Then
        strConsolidated = Display.Cells(rngCell.Row, 3).Value
        strPerson = Display.Cells(3, rngCell.Column).Value
        For lngPos = 0 To UBound(arrConcat)
            If LCase$(strConsolidated & strPerson) = LCase$(arrConcat(lngPos)) Then
                With WIPDATA
                    strComment = strComment & Chr(10) _
                        & "W/O " & .Range("B" & lngPos + 2).Value & Chr(10) _
                        & "OP# " & .Range("F" & lngPos + 2).Value & Chr(10) _
                        & "Qty " & .Range("I" & lngPos + 2).Value
                End With
            End If
        Next lngPos
        rngCell.ClearComments
        If Len(strComment) Then
            rngCell.AddComment (Right(strComment, Len(strComment) - 1))
            rngCell.Comment.Shape.TextFrame.Characters.Font.Size = 20
            rngCell.Comment.Shape.TextFrame.AutoSize = True
        End If
        strComment = vbNullString
    End If
Next rngCell

Тогда у меня есть почти идентичный код для запуска в другом диапазоне:

For Each rngCell In WIPDATA.Range("A2:A800")
    strConcat = strConcat & rngCell.Offset(0, 15) & rngCell & "||"
Next rngCell

arrConcat = Split(strConcat, "||")

For Each rngCell In Display.Range("V4:X24")
    If rngCell.Value >= 0 Then
        strConsolidated = Display.Cells(rngCell.Row, 21).Value
        strPerson = Display.Cells(3, rngCell.Column).Value
        For lngPos = 0 To UBound(arrConcat)
            If LCase$(strConsolidated & strPerson) = LCase$(arrConcat(lngPos)) Then
                With WIPDATA
                    strComment = strComment & Chr(10) _
                        & "W/O " & .Range("B" & lngPos + 2).Value & Chr(10) _
                        & "OP# " & .Range("F" & lngPos + 2).Value & Chr(10) _
                        & "Qty " & .Range("I" & lngPos + 2).Value
                End With
            End If
        Next lngPos
        rngCell.ClearComments
        If Len(strComment) Then
            rngCell.AddComment (Right(strComment, Len(strComment) - 1))
            rngCell.Comment.Shape.TextFrame.Characters.Font.Size = 20
            rngCell.Comment.Shape.TextFrame.AutoSize = True
        End If
        strComment = vbNullString
    End If
Next rngCell
End Sub

Сложите их вместе, и вы получитеполный код.

со второй частью, я получаю дополнительный комментарий, не заполнив детали для каждого найденного элемента:

Answer 1

Я заметил, что я сделал. И да, это потому, что я продублировал код. Первые 5 строк во втором коде необходимо было исключить, поскольку они уже были установлены в первом коде. Это заставляло это переопределять. Код в целом теперь работает как положено:

Dim rngCell As Range
Dim strComment As String, strConsolidated As String, strPerson As String, strConcat As String
Dim arrConcat() As String
Dim lngPos As Long

Dim WIPDATA As Worksheet
Dim Display As Worksheet
Set WIPDATA = Worksheets("WIPDATA")
Set Display = Worksheets("Display")

For Each rngCell In WIPDATA.Range("A2:A800")
    strConcat = strConcat & rngCell.Offset(0, 15) & rngCell & "||"
Next rngCell

arrConcat = Split(strConcat, "||")

For Each rngCell In Display.Range("D4:F25, H4:K25, Q4:R25")
    If rngCell.Value >= 0 Then
        strConsolidated = Display.Cells(rngCell.Row, 3).Value
        strPerson = Display.Cells(3, rngCell.Column).Value
        For lngPos = 0 To UBound(arrConcat)
            If LCase$(strConsolidated & strPerson) = LCase$(arrConcat(lngPos)) Then
                With WIPDATA
                    strComment = strComment & Chr(10) _
                        & "W/O " & .Range("B" & lngPos + 2).Value & Chr(10) _
                        & "OP# " & .Range("F" & lngPos + 2).Value & Chr(10) _
                        & "Qty " & .Range("I" & lngPos + 2).Value
                End With
            End If
        Next lngPos
        rngCell.ClearComments
        If Len(strComment) Then
            rngCell.AddComment (Right(strComment, Len(strComment) - 1))
            rngCell.Comment.Shape.TextFrame.Characters.Font.Size = 20
            rngCell.Comment.Shape.TextFrame.AutoSize = True
        End If
        strComment = vbNullString
    End If
Next rngCell
'9X Comments



For Each rngCell In Display.Range("V4:X24")
    If rngCell.Value >= 0 Then
        strConsolidated = Display.Cells(rngCell.Row, 21).Value
        strPerson = Display.Cells(3, rngCell.Column).Value
        For lngPos = 0 To UBound(arrConcat)
            If LCase$(strConsolidated & strPerson) = LCase$(arrConcat(lngPos)) Then
                With WIPDATA
                    strComment = strComment & Chr(10) _
                        & "W/O " & .Range("B" & lngPos + 2).Value & Chr(10) _
                        & "OP# " & .Range("F" & lngPos + 2).Value & Chr(10) _
                        & "Qty " & .Range("I" & lngPos + 2).Value
                End With
            End If
        Next lngPos
        rngCell.ClearComments
        If Len(strComment) Then
            rngCell.AddComment (Right(strComment, Len(strComment) - 1))
            rngCell.Comment.Shape.TextFrame.Characters.Font.Size = 20
            rngCell.Comment.Shape.TextFrame.AutoSize = True
        End If
        strComment = vbNullString
    End If
Next rngCell