具有条件格式调整的连接单元格

Question

我正在尝试连接两个单元格并根据字符串中是否存在“U”来格式化子字符串。我查看了其他几个线程来构建下面的代码，但它在 .characters 命令行中挂起。

连接也是基于 B、C 和 D 列中的值比较相同的迭代。在连续连接期间红色字符是否会保留在原位，还是我最好尝试根据结果字符串中带有 U 的部分来格式化最终字符串？

例如，如果 H 列的值要在下面的循环中按如下顺序连接在一起：

1. 7/11/2012 A & vbCrLf & 8/09/2014 A U
2. 7/11/2012 A & vbCrLf & 8/09/2014 A U & vbCrLf & 18/09/2013 A
3. 7/11/2012 A & vbCrLf & 8/09/2014 A U & vbCrLf & 18/09/2013 A & vbCrLf & 7/02/2014 A U

非常感谢任何帮助。 TIA。

Sub CustomFormat()

' CustomFormat Macro


Dim LR As Long, Rw As Long, FinishPoint As Integer

LR = Range("A" & Rows.Count).End(xlUp).Row

For Rw = LR To 1 Step -1

    If Range("B" & Rw).Value = Range("B" & Rw - 1).Value And _
    Range("C" & Rw).Value = Range("C" & Rw - 1).Value And _
    Range("D" & Rw).Value = Range("D" & Rw - 1).Value Then
        Range("H" & Rw - 1).Value = Range("G" & Rw - 1).Value & vbCrLf & Range("G" &   Rw).Value
    End If

    If InStr(1, Range("G" & Rw - 1).Value, "U") Then
        FinishPoint = Len(Range("G" & Rw - 1).Value)
        With Range("H" & Rw - 1).Value
            With .Characters(1, FinishPoint).Font.Color = vbRed
            End With
        End With
    End If

Next Rw

Answer 1

这个应该可以的：

Sub CustomFormat()
    Dim LR As Long, Rw As Long, i As Byte
    Dim FinishPoint As Integer, StartPoint As Integer

    LR = Range("A" & Rows.Count).End(xlUp).Row

    For Rw = LR To 2 Step -1

        If Range("B" & Rw).Value = Range("B" & Rw - 1).Value And _
                Range("C" & Rw).Value = Range("C" & Rw - 1).Value And _
                Range("D" & Rw).Value = Range("D" & Rw - 1).Value Then

            Range("H" & Rw - 1).Value = Range("G" & Rw - 1).Value & vbCrLf & Range("G" & Rw).Value

            If InStr(1, Range("G" & Rw - 1).Value, "U") Then
                FinishPoint = Len(Range("G" & Rw - 1).Value)
                With Range("H" & Rw - 1)
                    .Characters(1, FinishPoint).Font.Color = vbRed
                End With
            End If
            If InStr(1, Range("G" & Rw).Value, "U") Then
                StartPoint = Len(Range("G" & Rw - 1).Value) + 2
                FinishPoint = Len(Range("G" & Rw).Value) + StartPoint
                With Range("H" & Rw - 1)
                    .Characters(StartPoint, FinishPoint).Font.Color = vbRed
                End With
            End If
        End If
    Next Rw
End Sub

注意，InStr(1, Range("G" & Rw - 1).Value, "U") 区分大小写。如果单元格包含u，则返回0。你可以改成这个：InStr(1, UCase(Range("G" & Rw - 1).Value), "U")