Question

如果我有一个填充的列表视图，如果该列中已经存在子项，该如何更改字体颜色？

任何帮助将不胜感激。

这是我所拥有的，但不能正常工作

Sub dupeInterpreters(lvw As ListView, iSubItemIndex As Integer)
    Dim i As Integer
    Dim dupeI As Integer

    dupeI = 0

    For i = 1 To LVIV.ListItems.Count

        If LVIV.ListItems(i).SubItems(iSubItemIndex) = LVIV.ListItems(i).ListSubItems(iSubItemIndex).Text Then 'you could also use the LIKE operator
            'LVIV.ListItems(i).Selected = True
            LVIV.ListItems(i).Bold = True
            LVIV.ListItems(i).ListSubItems(iSubItemIndex).ForeColor = &HC000&
            dupeI = dupeI + 1
            'Exit For
        End If

    Next

End Sub

没有错误，但是突出显示了列表视图中的每个项目，而不仅仅是重复的值

Answer 1

尝试以下宏，该宏将格式化所有重复项...

Sub dupeInterpreters(LVIV As ListView, iSubItemIndex As Integer)

    Dim i As Long
    Dim j As Long
    Dim bDuplicate As Boolean

    bDuplicate = False
    For i = 1 To LVIV.ListItems.Count - 1
        For j = i + 1 To LVIV.ListItems.Count
            If LVIV.ListItems(j).SubItems(iSubItemIndex) = LVIV.ListItems(i).ListSubItems(iSubItemIndex).Text Then
                'LVIV.ListItems(i).Selected = True
                LVIV.ListItems(j).Bold = True
                LVIV.ListItems(j).ListSubItems(iSubItemIndex).ForeColor = &HC000&
                bDuplicate = True
            End If
        Next j
        If bDuplicate Then
            With LVIV.ListItems(i)
                .Bold = True
                .ListSubItems(iSubItemIndex).ForeColor = &HC000&
            End With
            bDuplicate = False
        End If
    Next

    Me.Repaint

End Sub

希望这会有所帮助！

Answer 2

这是另一种方法。这个使用了Dictionary对象来避免过多的循环，并且应该更有效...

Sub dupeInterpreters(LVIV As ListView, iSubItemIndex As Integer)

    Dim dicListSubItemCount As Object
    Dim strListSubItem As String
    Dim listItemIndex As Long

    Set dicListSubItemCount = CreateObject("Scripting.Dictionary")
    dicListSubItemCount.comparemode = 1 'case-insensitive comparison

    With LVIV
        For listItemIndex = 1 To .ListItems.Count
            strListSubItem = .ListItems(listItemIndex).ListSubItems(iSubItemIndex).Text
            dicListSubItemCount(strListSubItem) = dicListSubItemCount(strListSubItem) + 1
        Next listItemIndex
        For listItemIndex = 1 To .ListItems.Count
            strListSubItem = .ListItems(listItemIndex).ListSubItems(iSubItemIndex).Text
            If dicListSubItemCount(strListSubItem) > 1 Then
                With .ListItems(listItemIndex)
                    .Bold = True
                    .ListSubItems(iSubItemIndex).ForeColor = &HC000&
                End With
            End If
        Next listItemIndex
    End With

    Me.Repaint

    Set dicListSubItemCount = Nothing

End Sub

希望这会有所帮助！

Listview更改重复子项目的颜色

2 个答案: