时间戳

首页 > 解决方案 > 基于映射表进行比较

excel - 基于映射表进行比较

问题描述

在表 1 中，我有这些记录。
表 1，其中要更新的数据是

规则所在的表 2
规则所在的表 2

我想读取表 1 中的数据并将其与表 2 匹配，然后从表 2 列 C 中获取结果并将其放入表 1。

表 1 包括包含关键字的详细信息列。在此示例中，关键字是“居民”，借方列中的值。

我想检查表 1 中第一列中的单元格是否包含表 2 第一列中的关键字，表 1 列 2 等于表 2 列 2，然后使用表 2 中匹配的值更新表 1。

标签： excelvba

解决方案

使用正则表达式提取关键字和字典对象作为描述的查找表。

Option Explicit

Sub FillDescr()

    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Dim iLastRow As Long, i As Long, n As Long, s As String
    Dim sWord As String, sAmount As String
    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets("Sheet1")
    Set ws2 = wb.Sheets("Sheet2")
   
    ' create word dictionary from sheet 2
    Dim dictWord As Object, dictDescr As Object
    Set dictWord = CreateObject("Scripting.Dictionary")
    Set dictDescr = CreateObject("Scripting.Dictionary")
   
    iLastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To iLastRow
        sWord = UCase(Trim(ws2.Cells(i, "A")))
        sAmount = Trim(ws2.Cells(i, "B"))
        If sAmount <> "*" Then
            sAmount = Format(sAmount, "0.00")
        End If
        dictWord(sWord) = sAmount
        dictDescr(sWord & ";" & sAmount) = Trim(ws2.Cells(i, "C"))
    Next
   
    'Dim k
    'For Each k In dictWord.keys: Debug.Print k: Next
    'For Each k In dictDescr.keys: Debug.Print k: Next
   
    ' regular expresson to match words
    Dim Regex As Object, Match As Object
    Set Regex = CreateObject("vbscript.regexp")
    
    ' join words with | to make pattern
    s = Join(dictWord.keys, "|")
    'Debug.Print s

    ' capture text between ()
    With Regex
        .Global = False
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = "(" & s & ")"
    End With

    ' scan sheet 1
    iLastRow = ws1.Cells(Rows.Count, "B").End(xlUp).Row
    For i = 2 To iLastRow
    
        s = ws1.Cells(i, "B") ' text to search
        
        ' test for word match
        If Regex.test(s) Then
        
            Set Match = Regex.Execute(s)
            sWord = UCase(Match(0).submatches(0))
                      
            ' match all amounts if *
            If dictWord(sWord) = "*" Then
                sAmount = "*"
            Else
                sAmount = Format(ws1.Cells(i, "c"), "0.00")
            End If
            
            ' word;amount match in dictionary
            If dictDescr.exists(sWord & ";" & sAmount) Then
                ws1.Cells(i, "D") = dictDescr(sWord & ";" & sAmount)
                n = n + 1
            Else
                With ws1.Cells(i, "D")
                    .Value = "No match for " & sWord
                    .Interior.ColorIndex = 6 'Yellow
                End With
            End If
        Else
            With ws1.Cells(i, "D")
                .Value = "No key word match"
                .Interior.ColorIndex = 6 'Yellow
            End With
        End If
            
    Next
    MsgBox n & " rows matched", vbInformation

End Sub

推荐阅读