查找含有某个字根的字

abc0931

如附件所示

sheet1列出了汉字常用字的字根。现在在sheet2中的A列有一些词语，如果我在F2黄色单元格输入一个字根符号，希望在F2下面把 A列里面所有含这个字根的词语 都列出来。是否含有这个字根以sheet1字根表为准。
sheet2的A列可能有几百个词语。请问高手，是否可以通过vma实现这个功能？
感谢！！

abc0931

是希望通过VBA excel宏来实现，上面写错了。

abc0931

还有，sheet2中的A列不一定是二字词，有可能是三四个四五个字的词，这个词里任何一个字含有这个字根就要列出来。

shiruiqiang

去掉前面表1单词和字根的空格键后，代码如下：

shiruiqiang

opiona

忙乎半天 才发现 VBA内这些字符识别不出来
代码是按照一般字符做的,可以参考一下
字根.rar (124.71 KB, 下载次数: 0)

2024-2-24 01:12 上传

点击文件名下载附件

1. Sub OPI()
   
2.    
   
3.     Set SHX = Worksheets("Sheet2")
   
4.     SHX.AutoFilterMode = False  '//取消筛选
   
5.     MAXROW = SHX.Range("a" & SHX.Rows.Count).End(3).Row
   
6.     ARX = SHX.Range("A2:" & SHX.Cells(MAXROW, "A").Address).Value
   
7.    
   
8.     Set SHD = Worksheets("Sheet1")
   
9.     SHD.AutoFilterMode = False  '//取消筛选
   
10.     MAXROW = SHD.Range("a" & SHD.Rows.Count).End(3).Row
    
11. '    DRX = SHD.Range("A3:" & SHD.Cells(MAXROW, "C").Address).Value
    
12.     Set ZDD = CreateObject("Scripting.Dictionary")
    
13. '       For I = 1 To UBound(DRX, 1)
    
14. '        If InStr(DRX(I, 3), SHX.Range("F2").Value) > 0 Then
    
15. '            ZDD(DRX(I, 2)) = DRX(I, 1)
    
16. '        End If
    
17. '    Next
    
18.     For I = 3 To MAXROW
    
19.         If InStr(SHD.Cells(I, "C").Value, SHX.Range("F2").Value) > 0 Then
    
20.             ZDD(SHD.Cells(I, "B").Value) = SHD.Cells(I, "C").Value
    
21.         End If
    
22.     Next
    
23.    
    
24.     Set ZAD = CreateObject("Scripting.Dictionary")
    
25.     For I = 1 To UBound(ARX, 1)
    
26.         For X = 1 To Len(ARX(I, 1))
    
27.             StrX = Mid(ARX(I, 1), X, 1)
    
28.             If ZDD.exists(StrX) = True Then
    
29.                 ZAD(ARX(I, 1)) = StrX
    
30.                 Exit For
    
31.             End If
    
32.         Next
    
33.     Next
    
34.    
    
35.     ERX = ZAD.KEYS
    
36.     SHX.Range("F3:F" & SHX.Rows.Count).ClearContents
    
37.     For X = 0 To UBound(ERX)
    
38.         SHX.Cells(X + 3, "F").Value = ERX(X)
    
39.     Next
    
40.    
    
41. End Sub

复制代码

ykcbf1100

写到一半放弃了，原来发现根据字根查到的汉字并不是原来的汉字了。这个编码如何转换为汉字，目前不清楚。

shiruiqiang

ykcbf1100 发表于 2024-2-24 07:59
写到一半放弃了，原来发现根据字根查到的汉字并不是原来的汉字了。这个编码如何转换为汉字，目前不清楚。

把字根做字典
引用了ykcbf1100老师的代码，去处b\c列的空格

ykcbf1100

shiruiqiang 发表于 2024-2-24 08:12
把字根做字典试试
这里少了去除c、d列的特殊空格的代码

不错啊。。。

abc0931

感谢shiruiqiang老师提供的帮助，也感谢ykcbf1100老师的辛苦！！
问题已解决，编写的宏程序很好用！深表感谢！！