函数难点，VBA能否实现？

grldrkjhuy · 发表于 2020-2-14 09:38

函数难点，VBA能否实现？

一把小刀闯天下 · 发表于 2020-2-14 10:01

'2这个符号中后面有不可见字符，自己先处理一下，，，

Option Explicit

Sub test()
  Dim arr, dic, i, j, t
  Set dic = CreateObject("scripting.dictionary")
  For i = 1 To 4 Step 3
arr = Cells(1, i).CurrentRegion.Value
For j = 1 To UBound(arr, 1)
   arr(j, 2) = Replace(arr(j, 2), Space(1), vbNullString)
   arr(j, 2) = Replace(arr(j, 2), "●", "短")
   arr(j, 2) = Replace(arr(j, 2), "-", "长")
   dic(arr(j, 2)) = arr(j, 1)
Next
  Next
  arr = Range("h3:h" & [h3].End(xlDown).Row)
  ReDim brr(1 To UBound(arr, 1), 1 To 1)
  For i = 1 To UBound(arr, 1)
arr(i, 1) = Replace(arr(i, 1), Space(1), vbNullString)
arr(i, 1) = Replace(arr(i, 1), "。", vbNullString)
t = Split(arr(i, 1), "，")
For j = 0 To UBound(t)
   If Len(t(j)) Then
      If dic.exists(t(j)) Then
      brr(i, 1) = brr(i, 1) & "," & dic(t(j))
      Else
      brr(i, 1) = brr(i, 1) & "," & "?"
      End If
   End If
Next
If Len(brr(i, 1)) Then brr(i, 1) = Mid(brr(i, 1), 2)
  Next
  [i3].Resize(UBound(brr, 1)) = brr
End Sub

grldrkjhuy · 发表于 2020-2-14 10:22

一把小刀闯天下发表于 2020-2-14 10:01
'2这个符号中后面有不可见字符，自己先处理一下，，，

Option Explicit

谢谢，完美解决

moonlit123 · 发表于 2020-2-14 10:26

密码1.zip (23.05 KB, 下载次数: 4)

当作过完年的恢复练手了。
供参考。（思路差不多，无非replace和split）

wj2368 · 发表于 2020-2-14 11:05

.......................

zopey · 发表于 2020-2-14 12:01

密码2.zip (16.61 KB, 下载次数: 4)

zopey · 发表于 2020-2-14 14:51

放弃split，实现自动纠错

密码2.zip (16.92 KB, 下载次数: 7)

		自动登录	找回密码
密码			免费注册

[求助] 函数难点，VBA能否实现？

最新热点 /1