时间戳

首页 > 解决方案 > Exce VBA：用两个连续的大写单词突出显示单元格

excel - Exce VBA：用两个连续的大写单词突出显示单元格

问题描述

我想看看是否有一个宏来突出一个单元格，其中两个连续的单词都以大写字母开头（即苏珊史密斯，我们和苏珊史密斯一起去海滩，我不敢相信这风）

谢谢，米

标签： excelvba

解决方案

请尝试此解决方案。

将以下内容放在标准代码模块中，并在激活工作表的情况下运行它，您要使用连续的大写单词突出显示单元格...

Sub ShowDblCapCells()
  Dim c&, i&, j&, t&, v, w
  Const COLOR = xlThemeColorAccent4

  v = ActiveSheet.UsedRange
  For i = 1 To UBound(v)
    For j = 1 To UBound(v, 2)
      If Len(v(i, j)) Then
        For Each w In Split(v(i, j), " ")
          t = Asc(w)
          If t > 64 And t < 91 Then
            c = c + 1
            If c = 2 Then
                Cells(i, j).Interior.ThemeColor = COLOR: Exit For
            End If
          Else
            c = 0
          End If
        Next
      End If
    Next
  Next
End Sub

更新

请试试这个版本。我认为它可以解决您的错误...

Sub ShowDblCapCells()
  Dim c&, i&, j&, t$, v, w
  Const COLOR = xlThemeColorAccent4

  v = ActiveSheet.UsedRange
  For i = 1 To UBound(v)
    For j = 1 To UBound(v, 2)
      If Len(v(i, j)) Then
        For Each w In Split(v(i, j), " ")
          t = Left(w, 1)
          If t = UCase(t) Then
            c = c + 1
            If c = 2 Then
                Cells(i, j).Interior.ThemeColor = COLOR: Exit For
            End If
          Else
            c = 0
          End If
        Next
      End If
    Next
  Next
End Sub

更新#2

看到您的工作簿后，请使用以下版本...

Sub ShowDblCapCells()
  Dim c&, i&, j&, t&, v, w
  Const COLOR = xlThemeColorAccent4

  v = ActiveSheet.UsedRange
  For i = 1 To UBound(v)
    For j = 1 To UBound(v, 2)
      If Len(v(i, j)) Then
        c = 0
        For Each w In Split(v(i, j), " ")
          t = Asc(w)
          If t > 64 And t < 91 Then
            c = c + 1
            If c = 2 Then
                Cells(i, j).Interior.ThemeColor = COLOR: Exit For
            End If
          Else
            c = 0
          End If
        Next
      End If
    Next
  Next
End Sub

更新#3

即使在一行中有多个空格字符的子字符串，以下版本也可以工作......

Sub ShowDblCapCells()
  Dim c&, i&, j&, t&, v, w
  Const COLOR = xlThemeColorAccent4

  v = ActiveSheet.UsedRange
  For i = 1 To UBound(v)
    For j = 1 To UBound(v, 2)
      If Len(v(i, j)) Then
        c = 0
        For Each w In Split(v(i, j), " ")
          If Len(w) Then
            t = Asc(w)
            If t > 64 And t < 91 Then
              c = c + 1
              If c = 2 Then
                  Cells(i, j).Interior.ThemeColor = COLOR: Exit For
              End If
            Else
              c = 0
            End If
          End If
        Next
      End If
    Next
  Next
End Sub

推荐阅读