[算表] VBA 暗号解码比对抓错运算 需提高效率

楼主: Kamikiri (☒☒)   2019-10-08 00:40:26
软件:OFFICE 365 EXCEL
版本:1908
目前正在编写的功能是直接把一个工作表当成暗号表
A栏=暗号,B栏=解码后的对应词
另一个工作表则是杂乱无章的暗号跟解码后的词汇
然后要用暗号表去抓出文章内是否有出现暗号
而且是否解码后的词汇是否是正确的
例如
暗号表
A1=9527 B1=唐伯虎
A2=88 B2=掰掰
(下略)
解码表
A1=pppij"9527"clizxj B1=pppij"唐伯X"clizxj
C1=解码侦错:出现暗号:9527 解码遗漏:唐伯虎
大概是这种感觉
目前编写的代码大致如下:
For Row1 = 2 To 10000
For Row2 = 4 To 10000
Sheets("解码").Activate
If Sheets("暗号").Cells(Row1, 1).value <> "" Then
If Sheets("解码").Cells(Row2, 1).value <> "" Then
Code = Sheets("暗号").Cells(Row1, 1).value '暗号
Decry = Sheets("暗号").Cells(Row1, 2).value '解码对应词
Decode1 = InStr(1, (Cells(Row2, 1)), Code) '判断暗号文章是否有暗号
Decode2 = InStr(1, (Cells(Row2, 2)), Decry) '判断解码后是否有对应词
If Decode1 <> 0 And Decode2 = 0 Then '若暗号文章有暗号但解码后无对应词
For Col = 7 To 52
If Cells(Row2, Col).value = "" Then
Cells(Row2, Col).value = "解码遗漏:" & Decry
'在该文章列的7~52栏个别记下解码遗漏的对应词(因为可能一格内有多个不同暗号)
Exit For
End If
Next
End If
End If
End If
Next
Next
最后再用Textjoin把纪录在7~52栏的遗漏纪录整合在同一格内
然后为了方便辨识杂乱文章中的各个暗号
也去网络上找了帮特定字串上色的写法
https://access-excel.tips/excel-vba-change-partial-text-color/
我是用Macro 1 – Change partial text color using VBA Macro这个
目前的写法虽然可以正常运作
但速度上还是有点慢,在有600条暗号的情况下,至少也要60秒才能检查完
不知道是否有其他方式可以加快运算的速度?
而且现在还有个问题是如果暗号中有两个9527
但解码后只有一个唐伯虎,这种情况也不会被判断成解码缺失
所以在想是不是应该写另一个用资料剖析功能运算的版本来测试看看.....
把每个暗号个别分开,就可以连同数量不一致的也抓出来
希望有人可以提供意见,感谢
作者: soyoso (我是耀宗)   2019-10-08 07:27:00
1.减少巢状循环次数range.end().row来取得最后一笔有值的储存格列号2.只针对出现暗号的储存格,range.find或range.autofilter3.减少range.value的写入,而是先写入变量内,最后再一次性的写入范围内暗号有2个9527,只有1个唐伯虎方面(len(储存格)-len(replace(取代9527[变量])))/len(9527[变量]),或是ubound(split()),这样可得知字串内有出现多少次再判断是否次数有相符写入再拿出来,不确定所谓的拿出来是指?一次性写入范围内吗?如果是的话写入变量的话,变量(索引值,索引值[二维])=判断内原本要写入储存格的值;最后循环都执行完毕,在range(和变量维度、个数相同的范围)=变量 的方式写入range.value 或 range=值方面测试写入10次10万资料上二者看来是差不多的 https://i.imgur.com/ShXYHag.jpg如非一维的话,这要看dictionary是否可产生二维以上一维的话,一样range= dictionary.keys的方式dictionary.key写入列的话,应需用工作表函数transpose转置like或range.autofilter 方面可用万用字符
作者: foolkids (翼をください)   2019-10-10 17:57:00
一样推荐Dictionary,30万笔的比较时,效率还可以;超过的时候一样有效能问题,要再多做些手段

Links booklink

Contact Us: admin [ a t ] ucptt.com