绘本书名两两模糊匹配（仅会用字典和数组进行两两匹配，但无法实现完整功能）

lele400024

请教各位老师，因为馆藏图书中的书名是固定的，但是会有一些其他的字段，比如时间，比如柜号等等，但是平时不需要这些字段，所以在绘本管理工作表就没有写全，
现在主要通过条形码来查询，仍然有一些问题，不能查询全。希望各位老师能够帮忙想想办法。感谢。

这个是历史借阅工作表

这是馆藏图书工作表

这是绘本管理工作表

这是三个表的逻辑关系


现目前实现部分功能代码

1. Sub 图书排名2()
   
2.     Dim arr, brr, i&, r&, nr&, X, d, d1, d2, j, wb As Workbook, crr()
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.   Application.ScreenUpdating = False
   
5.   Application.DisplayAlerts = False
   
6.     Set d1 = CreateObject("Scripting.Dictionary")
   
7.     Set d2 = CreateObject("Scripting.Dictionary")
   
8.     'Set d5 = CreateObject("Scripting.Dictionary")
   
9. 
   
10.       With Sheets("历史借阅")
    
11.         nr = .Range("f" & Rows.Count).End(3).Row
    
12.     brr = .Range("d2:d" & nr)
    
13.     arr1 = .Range("f2:i" & nr)
    
14.     ReDim arr(1 To UBound(arr1), 1 To 5)
    
15.         For i = 1 To UBound(arr1)
    
16.             arr(i, 1) = arr1(i, 1)
    
17.             arr(i, 2) = brr(i, 1)
    
18.             arr(i, 3) = arr1(i, 2)
    
19.             arr(i, 4) = arr1(i, 3)
    
20.             arr(i, 5) = arr1(i, 4)
    
21.         Next
    
22.           'arr = .Range("f2:i" & nr)
    
23.           For i = 1 To UBound(arr)
    
24.               X = arr(i, 3)
    
25.               'm = m + 1
    
26.               If Not d.exists(X) Then
    
27.               d(X) = arr(i, 1) & "-" & arr(i, 2)
    
28.               d1(X) = 1 'arr(i, 5)
    
29.               d2(X) = arr(i, 5)
    
30.               Else
    
31.               d(X) = d(X) & "/" & arr(i, 1) & "-" & arr(i, 2)
    
32.               d1(X) = d1(X) + 1 'arr(i, 5)
    
33.               End If
    
34.           Next
    
35. 
    
36.       'j = [a65536].End(xlUp).Row
    
37.       'Range("h2:s" & j).HorizontalAlignment = xlCenter
    
38.       'Range("a" & j).CurrentRegion.Borders.LineStyle = xlContinuous
    
39.       '.[A1].Resize(1, 2) = Array("Number", "Name")
    
40.       .[j2].Resize(d.Count, 1) = Application.Transpose(d2.items)
    
41.       .[k2].Resize(d.Count, 1) = Application.Transpose(d.keys)
    
42.       .[l2].Resize(d.Count, 1) = Application.Transpose(d.items)
    
43.       .[m2].Resize(d.Count, 1) = Application.Transpose(d1.items)
    
44.       d.RemoveAll
    
45.       d1.RemoveAll
    
46.       arr = .Range("j2:m" & nr)
    
47.       
    
48.        End With
    
49.       With Sheets("绘本管理")
    
50.         j = .Range("b" & Rows.Count).End(3).Row
    
51.         brr = .Range("b2:d" & j)
    
52. 
    
53.           For i = 1 To UBound(arr)
    
54.               X = Val(arr(i, 1))
    
55.               If Not d.exists(X) Then
    
56.               d(X) = Array(arr(i, 1), arr(i, 2), arr(i, 3), arr(i, 4))
    
57.               End If
    
58.           Next
    
59.           For r = 1 To UBound(brr)
    
60.                 x2 = Val(brr(r, 3))
    
61.                 If d.exists(x2) Then
    
62.                   brr(r, 2) = d(x2)(2)
    
63.                   brr(r, 3) = d(x2)(3)
    
64.                   Else
    
65.                   brr(r, 2) = ""
    
66.                   brr(r, 3) = ""
    
67.                 End If
    
68.           Next
    
69. 
    
70.          .[j2].Resize(UBound(brr), UBound(brr, 2)) = brr
    
71.                
    
72.         'Sheets("历史借阅").[n2].Resize(UBound(arr), UBound(arr, 2)) = arr
    
73.       End With
    
74.   Application.ScreenUpdating = True
    
75.   Application.DisplayAlerts = True
    
76.   
    
77. 
    
78. End Sub
    

复制代码

书名两两模糊匹配.rar (397.68 KB, 下载次数: 18)

2021-3-19 15:53 上传

点击文件名下载附件

zpy2

要通过条形码来查询，仍然有一些问题，不能查询全

条形码不唯一？

lele400024

zpy2 发表于 2021-3-19 19:43
要通过条形码来查询，仍然有一些问题，不能查询全

条形码不唯一？

谢谢老师提出的疑问，条码本来是唯一的，但是存在两个问题，
第一个问题：是部分条码格式问题，有一些不可见空格，有些是数值格式，有些是文本格式，能力有限，只能做部分处理，导致有一部分无法匹配。
第二个问题：条码不全或者有变动，现在就是通过条码的对比来匹配的，但是“绘本管理”工作表中有些绘本无条码，就直接不能匹配。或者绘本管理工作表中条码与馆藏图书工作表条码不一致，有可能是后期变动，也有可能是前期录入系统时的错误，就需要书名去匹配，而不单纯是条码匹配。
感谢老师。

zpy2

lele400024 发表于 2021-3-20 10:07
谢谢老师提出的疑问，条码本来是唯一的，但是存在两个问题，
第一个问题：是部分条码格式问题，有一些不 ...

我用sql匹配了一下 馆藏书名 和 借阅书名，供参考。

lele400024

zpy2 发表于 2021-3-20 12:12
我用sql匹配了一下 馆藏书名 和 借阅书名，供参考。

你好，我对比了下，相似度小于14的会存在有些问题。这个我怎么用于EXCEL中呢，不是很清楚，谢谢。

zpy2

lele400024 发表于 2021-3-20 14:16
你好，我对比了下，相似度小于14的会存在有些问题。这个我怎么用于EXCEL中呢，不是很清楚，谢谢。

这种感觉没有完美的，否则也不要计算机了。
直接对照表复制粘贴到excel吧

lele400024

zpy2 发表于 2021-3-20 14:30
这种感觉没有完美的，否则也不要计算机了。
直接对照表复制粘贴到excel吧

好吧，谢谢