请求：输入法词自动编码

cjs3038693

本人自研了一套形码输入法，单字编码基本定型，效果不错。现需要制作出词编码，检验一下词编码的效果，请老师们赐教！

maditate

你怎么把王码变成了你自己研究的形码输入法了呢？

cjs3038693

不好意思，我没有说明，
这只是用五笔编码做个试验，

cjs3038693

我的字根比和王码规律得多，非常好记，不用识别码在GB2310的6763字中只有700多重码字，王码是1200多个，我加上几个区重码仅有300多个重码字，王码是500多，

maditate

词自动编码.rar (11.26 KB, 下载次数: 7)

2017-4-26 12:55 上传

点击文件名下载附件

cjs3038693 发表于 2017-4-26 12:26
我的字根比和王码规律得多，非常好记，不用识别码在GB2310的6763字中只有700多重码字，王码是1200多个，我 ...

Sub test()
        Set d = CreateObject("Scripting.Dictionary")
        
        
        rr = Cells(Rows.Count, 1).End(xlUp).Row
        arr = Range("A1:B" & rr)
        For h = LBound(arr) + 1 To UBound(arr)
          d(arr(h, 1)) = arr(h, 2)
        Next h
        
        rr = Cells(Rows.Count, 3).End(xlUp).Row
        arr = Range("C1:D" & rr)
        
        For h = LBound(arr) + 1 To UBound(arr)
           If d.Exists(arr(h, 1)) = False Then
              pp = Empty
              l = Len(arr(h, 1))
              If l = 2 Then
                 r1 = Mid(arr(h, 1), 1, 1)
                 r2 = Mid(arr(h, 1), 2, 1)
                 a = d.Item(r1)
                 pp = Mid(a, 1, 2)
                 a = d.Item(r2)
                 pp = pp & Mid(a, 1, 2)
                 d(arr(h, 1)) = pp
                 
              ElseIf l = 3 Then
              
                 r1 = Mid(arr(h, 1), 1, 1)
                 r2 = Mid(arr(h, 1), 2, 1)
                 r3 = Mid(arr(h, 1), 3, 1)
                 a = d.Item(r1)
                 pp = Mid(a, 1, 1)
                 a = d.Item(r2)
                 pp = pp & Mid(a, 1, 1)
                 a = d.Item(r3)
                 pp = pp & Mid(a, 1, 2)
                 d(arr(h, 1)) = pp
              
              ElseIf l >= 4 Then
                 r1 = Mid(arr(h, 1), 1, 1)
                 r2 = Mid(arr(h, 1), 2, 1)
                 r3 = Mid(arr(h, 1), 3, 1)
                 r4 = Mid(arr(h, 1), l, 1)
                 a = d.Item(r1)
                 pp = Mid(a, 1, 1)
                 a = d.Item(r2)
                 pp = pp & Mid(a, 1, 1)
                 a = d.Item(r3)
                 pp = pp & Mid(a, 1, 1)
         
                 a = d.Item(r4)
                 pp = pp & Mid(a, 1, 1)
                 d(arr(h, 1)) = pp
              End If
           End If
        Next h
        
        K = d.Keys
        t = d.Items
        ThisWorkbook.Sheets("Sheet1").Range("H2").Resize(UBound(t) + 1) = Application.Transpose(t)   '此行 H2 可以改为其它单元格，
        ThisWorkbook.Sheets("Sheet1").Range("G2").Resize(UBound(K) + 1) = Application.Transpose(K)   '此行 G2 可以改为其它单元格，
        
End Sub

cjs3038693

maditate 发表于 2017-4-26 12:52
Sub test()
        Set d = CreateObject("Scripting.Dictionary")
        

谢谢，谢谢，非常感谢！

cjs3038693

cjs3038693 发表于 2017-4-26 13:27
谢谢，谢谢，非常感谢！

试了下，错误。这里是我忽略了一个问题，单字列的字顺序与字词列的字词顺序是不一样的，可能是这个原因所倒致的吧，请你检查一下，谢谢！

cjs3038693

maditate 发表于 2017-4-26 12:52
Sub test()
        Set d = CreateObject("Scripting.Dictionary")
        

还有我的单字编码是6765个（以后可能是20000多个），字词是约15000个（以后可能是65000个），所以请满足这些要求。

maditate

cjs3038693 发表于 2017-4-26 13:43
试了下，错误。这里是我忽略了一个问题，单字列的字顺序与字词列的字词顺序是不一样的，可能是这个原因所 ...

代码工作原理。
先读取第一，第二列。将字与代码读进词典。
再读第三列，判断是单字，还是词组。如果是单字则不作处理，如果是词组，则配代码。并读进词典。
最后输出词典。
输出的内容前半部份是第一第二列的内容，后半部份是第三列的词加配的代码。

我不知道你说的错误指的是什么。

如果需要可进一步说明，我再另外改写代码。

maditate

cjs3038693 发表于 2017-4-26 13:54
还有我的单字编码是6765个（以后可能是20000多个），字词是约15000个（以后可能是65000个），所以请满足 ...

单字2万多个，加上词6万多个，已经超过了2003版工作表的总行数了，数据输出有问题，你可以分两次配代码。