首页 > 解决方案 > 使用 VBA 在 excel 中匹配包含字符分隔值的列

问题描述

我在工作表的两列中有数据,如下所示。

+------------------+---------------------------------------+
|       A          |                  B                    |
+------------------+---------------------------------------+
| Hector Hall      |                                       |
| Guy Gardner      |                                       |
| Bart Allen       |                                       |
| Kyle Rayner      |                                       |
| Dick Grayson     |                                       |
| Khalid Nassour   |                                       |
| Kent Nelson      |                                       |
| Tim Drake        |                                       |
| Bat 2            | Dick Grayson; James Gordon            |
| James Gordon     |                                       |
| Hal Jordan       |                                       |
| Robin 2          | Tim Drake; Stephanie Brown            |
| Jay Garrick      |                                       |
| Jason Todd       |                                       |
| Flash 1          | Barry Allen; Wally West               |
| GL 2             | Guy Gardner; Kyle Rayner; Jon Stewart |
| Fate 1           | Kent Nelson; Khalid Nassour           |
| GL 1             | Alan Scott; Simon Baz                 |
| Simon Baz        |                                       |
| Robin 1          | Dick Grayson; Damien Wayne            |
| Alan Scott       |                                       |
| Bruce Wayne      |                                       |
| Jean Paul Valley |                                       |
| Wally West       |                                       |
| Bat 1            | Bruce Wayne; Jean Paul Valley         |
+------------------+---------------------------------------+

我正在尝试使用VBA执行以下条件格式的代码创建一个 ActiveX 命令按钮:

1) 突出显示A中所有在B中以分号分隔值存在的单元格。

2)突出显示B中的所有单元格,其分号分隔的值在A中不存在。

目前,我可以通过在单独的工作表中获取所有分号分隔的值并使用它进行匹配来做到这一点。但它变得棘手,因为B中的分号分隔值的数量不统一并且可能变化很大。

在 excel VBA 中有更优雅的方法吗?

标签: excelvbamatching

解决方案


那应该工作

1)

Sub butA()

Dim szyt2 As Worksheet
Dim j As Long, i As Long, k As Long
Dim lastRow As Long
Dim araj1
Dim araj2

Set szyt2 = ThisWorkbook.Sheets("Sheet2")
lastRow = szyt2.Cells(Rows.Count, 1).End(xlUp).row
araj1 = szyt2.Range("A1:A" & lastRow).Value
araj2 = szyt2.Range("B1:B" & lastRow).Value

For i = 1 To UBound(araj2, 1)
    If Not (araj2(i, 1) = "") Then
        If InStr(1, araj2(i, 1), ";") > 0 Then
            ar = Split(araj2(i, 1), ";")
            For k = 0 To UBound(ar)
                For j = 1 To UBound(araj1, 1)
                    If araj1(j, 1) = ar(k) Then
                        szyt2.Cells(j, 1).Interior.ColorIndex = 3
                    End If
                Next
            Next
        End If
    End If
Next

End Sub

2)

Sub butB()

Dim szyt2 As Worksheet
Dim j As Long, i As Long, k As Long
Dim lastRow As Long
Dim araj1
Dim araj2

Set szyt2 = ThisWorkbook.Sheets("Sheet2")
lastRow = szyt2.Cells(Rows.Count, 1).End(xlUp).row
araj1 = szyt2.Range("A1:A" & lastRow).Value
araj2 = szyt2.Range("B1:B" & lastRow).Value
counter = 0

For i = 1 To UBound(araj2, 1)
    If Not (araj2(i, 1) = "") Then
        If InStr(1, araj2(i, 1), ";") > 0 Then
            ar = Split(araj2(i, 1), ";")
            For k = 0 To UBound(ar)
                For j = 1 To UBound(araj1, 1)
                    If araj1(j, 1) = ar(k) Then
                        counter = counter + 1
                    End If
                Next
                If counter > 0 Then Exit For
            Next
            If counter > 0 Then
                szyt2.Cells(i, 2).Interior.ColorIndex = 3
            End If
        End If
    End If
    counter = 0
Next

End Sub

推荐阅读