excel - 评估字符串以加入一维数组
问题描述
我有以下生成字符串的 UDF
Sub Test_ConvertToUnicode_UDF()
Dim s
s = ConvertToUnicode("الحديث")
Debug.Print Evaluate("""" & s & """")
End Sub
Function ConvertToUnicode(ByVal sInput As String)
Dim s As String, i As Long
For i = 1 To Len(sInput)
s = s & "Chr(" & Asc(Mid(sInput, i, 1)) & ")" & IIf(i <> Len(sInput), ", ", Empty)
Next i
ConvertToUnicode = "Join(Array(" & s & "), Empty)"
End Function
如何评估字符串输出,以便能够获得与将其作为命令行键入的结果相同的结果?我的意思是 UDF 将使用的字符串“الحديث”转换为该字符串
Join(Array(Chr(199), Chr(225), Chr(205), Chr(207), Chr(237), Chr(203)), Empty)
我如何评估能够像那样使用的线
Debug.Print Join(Array(Chr(199), Chr(225), Chr(205), Chr(207), Chr(237), Chr(203)), Empty)
也在这里发布 https://www.mrexcel.com/board/threads/evaluate-string-to-join-1d-array.1140921/ http://www.eileenslounge.com/viewtopic.php?f=30&t=35014
解决方案
有一个示例显示如何使用ScriptControl在 VBA 中评估 VB 表达式:
Option Explicit
Sub Test()
Dim oSC As Object
Set oSC = CreateObjectx86("ScriptControl")
oSC.Language = "VBScript"
Cells(1, 1).Value = oSC.Eval("Join(Array(ChrW(1575), ChrW(1604), ChrW(1581), ChrW(1583), ChrW(1610), ChrW(1579)), Empty)")
End Sub
Function CreateObjectx86(Optional sProgID)
Static oWnd As Object
Dim bRunning As Boolean
#If Win64 Then
bRunning = InStr(TypeName(oWnd), "HTMLWindow") > 0
Select Case True
Case IsMissing(sProgID)
If bRunning Then oWnd.Lost = False
Exit Function
Case IsEmpty(sProgID)
If bRunning Then oWnd.Close
Exit Function
Case Not bRunning
Set oWnd = CreateWindow()
oWnd.execScript "Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID) End Function", "VBScript"
oWnd.execScript "var Lost, App;": Set oWnd.App = Application
oWnd.execScript "Sub Check(): On Error Resume Next: Lost = True: App.Run(""CreateObjectx86""): If Lost And (Err.Number = 1004 Or Err.Number = 0) Then close: End If End Sub", "VBScript"
oWnd.execScript "setInterval('Check();', 500);"
End Select
Set CreateObjectx86 = oWnd.CreateObjectx86(sProgID)
#Else
Set CreateObjectx86 = CreateObject(sProgID)
#End If
End Function
Function CreateWindow()
' source http://forum.script-coding.com/viewtopic.php?pid=75356#p75356
Dim sSignature, oShellWnd, oProc
On Error Resume Next
Do Until Len(sSignature) = 32
sSignature = sSignature & Hex(Int(Rnd * 16))
Loop
CreateObject("WScript.Shell").Run "%systemroot%\syswow64\mshta.exe about:""<head><script>moveTo(-32000,-32000);document.title='x86Host'</script><hta:application showintaskbar=no /><object id='shell' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>shell.putproperty('" & sSignature & "',document.parentWindow);</script></head>""", 0, False
Do
For Each oShellWnd In CreateObject("Shell.Application").Windows
Set CreateWindow = oShellWnd.GetProperty(sSignature)
If Err.Number = 0 Then Exit Function
Err.Clear
Next
Loop
End Function
如果您在 Office 365 上遇到错误
无法创建指定语言的脚本引擎
您可以按照此处所述修复该问题:Registry key to re-enable VBScript controls in Office 365。
还有另一个使用 htmlfileEval()
函数的代码,它已经过时了,因为它只适用于 Win 7,所以小心使用它:
Option Explicit
Sub test()
Dim sample
sample = "Join(Array(ChrW(1575), ChrW(1604), ChrW(1581), ChrW(1583), ChrW(1610), ChrW(1579)), Empty)"
Dim result
Dim valid
eval sample, result, valid
If valid Then
Cells(1, 1).Value = result
Else
Cells(1, 1).Value = "Oops"
End If
End Sub
Sub eval(expr, ret, ok)
Static htmlFile As Object
If htmlFile Is Nothing Then
Set htmlFile = CreateObject("htmlfile")
htmlFile.parentWindow.execScript "Function evalExpr(expr): evalExpr = Eval(expr): End Function", "vbscript"
End If
On Error Resume Next
ret = htmlFile.parentWindow.evalExpr(expr)
ok = Err.Number = 0
End Sub
推荐阅读
- r - 如何从 R 数据框中获取条件结果
- excel - 如何转到上一个单元格并使此代码更快?
- python - 对数组的特定索引求和以获得另一个数组
- c# - 以 xamarin 形式从 base64 下载文件
- powershell - 将一个目录中的多个文件合并为一个文件
- kubernetes - kubernetes 部署/副本集在删除后重新创建
- python - python 词法分析器仅附加到数组的第一个关键字
- python - 使用 Selenium 和 Python 进行重复搜索。给我那些他们没有结果的
- python - pycurl.multicurl - 无法得到我返回的结果,只有对象内存地址
- google-cloud-dataflow - 将 PubSub 流式传输到 Spanner - Wait.on 步骤