更新以后无法使用了！总是提示“excel或wps未运行”。
我一直回退到v7版本，都无法使用
可能你系统更新了还是啥的，脚本无法调用com接口，所以无法连接运行中的excel或者wps程序，很多人的系统有这问题，我也试过了真不知道怎么解决- -
我用ai修复了一下，现在可以用了。我现在把ai的答复发给你。
竟然能修复？是修改了什么
就是上面三个地方改了啊！下面是改完后的代码！
{
"LimitSingleInstance": true,
"SummaryExpression": "$$",
"SubPrograms": [
"Id": "3eed2165-c132-464a-926d-daf50edafc43",
"Icon": null,
"Name": "运行VBS脚本",
"Description": "",
"CreateTimeUtc": "2022-12-30T03:38:57.9632888Z",
"LastEditTimeUtc": "2022-12-30T04:09:49.555719+08:00",
"IsLocalEdited": false,
"Variables": [
"Key": "代码",
"IsLocked": false,
"Type": 0,
"Desc": "默认的文本变量",
"DefaultValue": "",
"SaveState": false,
"IsInput": true,
"IsOutput": false,
"ParamName": "",
"InputParamInfo": null,
"OutputParamInfo": null,
"TableDef": null,
"CustomType": null,
"Group": null
},
"Key": "stdout",
"Desc": "",
"IsInput": false,
"IsOutput": true,
"Key": "输出结果",
"Type": 2,
"DefaultValue": "false",
}
],
"Steps": [
"StepRunnerKey": "sys:if",
"InputParams": {
"condition": {
"VarKey": null,
"Value": "$= {输出结果} == true"
"OutputParams": {},
"IfSteps": [
"StepRunnerKey": "sys:runScript",
"script": {
"VarKey": "代码",
"Value": null
"type": {
"Value": "CUSTOM"
"ext": {
"Value": "VBS"
"encoding": {
"Value": "utf-16"
"runner": {
"Value": "Cscript"
"argTemplate": {
"Value": "%FILE%"
"outputEncoding": {
"Value": "oem"
"workingDir": {
"Value": ""
"runAsAdmin": {
"Value": "0"
"waitToExit": {
"Value": "1"
"OutputParams": {
"stdout": "stdout",
"stderr": null
"IfSteps": null,
"ElseSteps": null,
"Note": "",
"Disabled": false,
"Collapsed": false,
"DelayMs": 0
"StepRunnerKey": "sys:strReplace",
"Value": "single"
"input": {
"VarKey": "stdout",
"old": {
"Value": "Microsoft.*保留所有权利。"
"new": {
"escapeOld": {
"Value": "true"
"replaceEscapes": {
"useRegex": {
"ignoreCase": {
"singleLine": {
"multiLine": {
"Value": "false"
"output": "stdout"
"StepRunnerKey": "sys:stringProcess",
"data": {
"method": {
"Value": "trim"
"stopIfFail": {
"output": "stdout",
"isSuccess": null
"ElseSteps": [
"stdout": null,
"SubPrograms": [],
"TemplateId": null,
"TemplateRevision": 0,
"UseServerVersion": null,
"IsProtected": null,
"SharedId": "e2489f51-b35d-472c-dc4b-08db3330aaec",
"ShareTimeUtc": "2023-04-03T07:58:01.9663857Z"
"Key": "text",
"ParamName": null,
"Key": "匹配方式",
"DefaultValue": "精确匹配",
"StepRunnerKey": "sys:simpleIf",
"Value": "$={quicker_in_param}==\"模糊匹配查找\""
"StepRunnerKey": "sys:subprogram",
"subProgram": {
"Value": "运行VBS脚本"
"var:代码": {
"Value": "Dim application,sh,rng\r\nOn Error Resume Next\r\nSet application = GetObject(,\"excel.application\")\r\nIf application Is Nothing Then Set application = GetObject(,\"et.application\")\r\nIf application Is Nothing Then Set application = CreateObject(\"excel.application\")\r\nIf application Is Nothing Then Set application = CreateObject(\"et.application\")\r\nOn Error GoTo 0\r\nIf application Is Nothing Then\r\n MsgBox \"无法连接 Excel 或 WPS，请检查：\" & vbCrLf & \"1. 确认 Excel/WPS 已启动\" & vbCrLf & \"2. Excel/WPS 和 Quicker 使用相同权限运行\", vbExclamation, \"连接失败\"\r\n WScript.Quit\r\nEnd If\r\n\r\nIf application Is Nothing Then Set application = GetObject(,\"et.application\")\r\nIf application Is Nothing Then Set application = CreateObject(\"excel.application\")\r\nIf application Is Nothing Then Set application = CreateObject(\"et.application\")\r\nOn Error GoTo 0\r\nIf application Is Nothing Then\r\n MsgBox \"无法连接 Excel 或 WPS，请检查：\" & vbCrLf & \"1. 确认 Excel/WPS 已启动\" & vbCrLf & \"2. Excel/WPS 和 Quicker 使用相同权限运行\", vbExclamation, \"连接失败\"\r\n WScript.Quit\r\nEnd If\r\nSet sh = application.activesheet\r\nset rng = application.selection.specialcells(12)\r\nSet rng2 = application.InputBox(\"请选择数据源区域\" & vbCrLf & \"请确保查找值与查找结果在选择区域的两端\",\"Quicker提示！\",,,,,,8)\r\nSet sh2 = rng2.parent\r\nSet rng2 = application.intersect(rng2,sh2.usedrange)\r\narr = rng2.value2\r\nn = UBound(arr,2)\r\nSet d = CreateObject(\"scripting.dictionary\")\r\nSet d2 = CreateObject(\"scripting.dictionary\")\r\nFor i = 1 To UBound(arr)\r\n\td(CStr(arr(i,1))) = arr(i,n)\r\n\td2(CStr(arr(i,n))) = arr(i,1)\r\nNext\r\nSet rng2 = application.InputBox(\"请选择保存结果的位置\",\"Quicker提示！\",,,,,,8)\r\nrow = rng2.row:col = rng2.column\r\nrnum = row - rng.row:cnum = col - rng.column\r\nkeyrr1 = d.Keys\r\nkeyrr2 = d2.Keys\r\nFor Each area In rng.areas\r\n\tarr = area.resize(area.rows.count+1)\r\n\tjgrr1 = arr:jgrr2 = arr\r\n\tk1 = 0:k2 = 0\r\n\tFor i = 1 To UBound(arr)-1\r\n\t\tczz = CStr(arr(i,1))\r\n\t\ttemprr = Filter(keyrr1,czz)\r\n\t\tIf UBound(temprr) > -1 Then\t\t\r\n\t\t\tjgrr1(i,1) = d(temprr(0))\r\n\t\t\tk1 = k1 + 1\r\n\t\tElse\r\n\t\t\tjgrr1(i,1) = \"\"\r\n\t\tEnd If\r\n\t\t\r\n\t\ttemprr = Filter(keyrr2,czz)\r\n\t\tIf UBound(temprr) > -1 Then\t\t\r\n\t\t\tjgrr2(i,1) = d2(temprr(0))\r\n\t\t\tk2 = k2 + 1\r\n\t\tElse\r\n\t\t\tjgrr2(i,1) = \"\"\r\n\t\tEnd If\r\n\tNext\r\n\tIf k1 >= k2 Then\r\n\t\tarea(1).offset(rnum,cnum).resize(UBound(arr)-1).value = jgrr1\r\n\tElseIf k2 > k1 Then\r\n\t\tarea(1).offset(rnum,cnum).resize(UBound(arr)-1).value = jgrr2\r\n\tEnd If\t\r\nNext\r\n\r\n\r\nSet application = Nothing\r\nSet sh = nothing\r\nset rng = nothing"
"var:输出结果": {
"skipDebugOutput": {
"summary": {
"isSuccess": null,
"var:stdout": null
"StepRunnerKey": "sys:stop",
"Value": "default"
"isError": {
"return": {
"showMessage": {
"Value": "$={quicker_in_param}==\"查找近似值\""
"StepRunnerKey": "sys:officehelper",
"operation": {
"Value": "execVBA"
"appType": {
"Value": "excel_et"
"code": {
"Value": "Sub 查找近似值()\r\nDim rng As Range, rng2 As Range, d As Object\r\nDim i%, j%, k%, m%, s$, stra$, strb$, jgstr$\r\n\r\nSet rng = Selection\r\nSet rng = rng.SpecialCells(12)\r\nSet rng2 = Application.InputBox(\"请选择数据源\", \"Quicker提示！\", , , , , , 8)\r\narr = Application.Intersect(rng2, rng2.Parent.UsedRange).Value\r\nSet d = CreateObject(\"scripting.dictionary\")\r\nIf Application.CountA(rng.Offset(0, 1)) Then\r\n Set rng2 = Application.InputBox(\"请选择结果存放位置\", \"Quicker提示！\", , , , , , 8)\r\n col = rng2.Column - rng.Column\r\nElse\r\n col = 1\r\nEnd If\r\nFor Each rn In rng.Areas\r\n jgrr = rn.Resize(rn.Rows.Count + 1, 1).Value\r\n For i = 1 To UBound(jgrr) - 1\r\n stra = jgrr(i, 1)\r\n jgstr = \"\"\r\n n = -1\r\n For j = 1 To UBound(arr)\r\n strb = arr(j, 1)\r\n m = 0\r\n For k = 1 To Len(stra)\r\n s = Mid(stra, k, 1)\r\n If s <> \" \" Then\r\n If InStr(strb, s) Then\r\n m = m + 1\r\n strb = Replace(strb, s, \"\", , 1)\r\n End If\r\n End If\r\n Next k\r\n If m > n Then\r\n jgstr = arr(j, 1)\r\n n = m\r\n ElseIf m = n Then\r\n jgstr = jgstr & \"\\/\" & arr(j, 1)\r\n End If\r\n Next j\r\n If InStr(jgstr, \"\\/\") Then\r\n temprr = Split(jgstr, \"\\/\")\r\n For k = 0 To UBound(temprr)\r\n temprr(k) = k + 1 & \":\" & temprr(k)\r\n Next\r\n jgstr = \"请手动选择【\" & stra & \"】的最近似值。\" & vbCrLf & Join(temprr, vbCrLf)\r\n k = Application.InputBox(jgstr, \"Quicker提示！\", , , , , , 1)\r\n If k > UBound(temprr) + 1 Then '如果选择的序号超出范围则返回一个空值\r\n jgrr(i, 1) = \"\"\r\n Else\r\n jgstr = temprr(k - 1)\r\n jgstr = Mid(jgstr, InStr(jgstr, \":\") + 1)\r\n jgrr(i, 1) = jgstr\r\n End If\r\n Else\r\n jgrr(i, 1) = jgstr\r\n End If\r\n Next i\r\n rn.Offset(0, col).Value = jgrr\r\nNext\r\nEnd Sub\r\n"
"waitResp": {
"waitMs": {
"resp": null,
"errMessage": null
"Value": "$={quicker_in_param}==\"区分\""
"StepRunnerKey": "sys:assign",
"Value": "精确匹配"
"output": "匹配方式"
"Value": "其它"
"Collapsed": true,
"Value": "$$'查找方式：查找首个符合条件的值;匹配方式：精确匹配或者不区分大小写\r\nDim application,sh,rng\r\nOn Error Resume Next\r\nSet application = GetObject(,\"excel.application\")\r\nIf application Is Nothing Then Set application = GetObject(,\"et.application\")\r\nIf application Is Nothing Then Set application = CreateObject(\"excel.application\")\r\nIf application Is Nothing Then Set application = CreateObject(\"et.application\")\r\nOn Error GoTo 0\r\nIf application Is Nothing Then\r\n MsgBox \"无法连接 Excel 或 WPS，请检查：\" & vbCrLf & \"1. 确认 Excel/WPS 已启动\" & vbCrLf & \"2. Excel/WPS 和 Quicker 使用相同权限运行\", vbExclamation, \"连接失败\"\r\n WScript.Quit\r\nEnd If\r\n\r\nIf application Is Nothing Then Set application = GetObject(,\"et.application\")\r\nIf application Is Nothing Then Set application = CreateObject(\"excel.application\")\r\nIf application Is Nothing Then Set application = CreateObject(\"et.application\")\r\nOn Error GoTo 0\r\nIf application Is Nothing Then\r\n MsgBox \"无法连接 Excel 或 WPS，请检查：\" & vbCrLf & \"1. 确认 Excel/WPS 已启动\" & vbCrLf & \"2. Excel/WPS 和 Quicker 使用相同权限运行\", vbExclamation, \"连接失败\"\r\n WScript.Quit\r\nEnd If\r\nSet sh = application.activesheet\r\nset rng = application.selection\r\nIf rng.columns.count > 1 Then Set rng = rng.resize(,1)\r\n\r\nppfs = \"{匹配方式}\"\r\n\r\non error resume next\r\nSet rng2 = application.inputbox(\"请选择数据源区域,注意查找值和结果在区域两端\" & vbcrlf & \"或者先选择查找值所在列后按住CTRL键选择需要返回的结果列\",,,,,,,8)\r\nif err then WScript.Quit\r\nif rng2.areas.count>1 then\r\n\tcall xlookup\r\n\twscript.quit\r\nend if\r\nSet rng2 = application.intersect(rng2,rng2.parent.usedrange)\r\n'写入字典\r\n\tbrr = rng2.value\r\n\tml = UBound(brr,2)\r\n\tSet d1 = CreateObject(\"scripting.dictionary\")\r\n\tSet d2 = CreateObject(\"scripting.dictionary\")\r\n\t'创建两个字典\r\n\tFor i = 1 To UBound(brr)\r\n\t\tIf ppfs = \"精确匹配\" then\r\n\t\t\tIf Not d1.Exists(brr(i,1) & \"\") then d1(brr(i,1) & \"\") = brr(i,ml) & \"\"\r\n\t\t\tIf Not d2.Exists(brr(i,ml) & \"\") then d2(brr(i,ml) & \"\") = brr(i,1) & \"\"\r\n\t\tElse\r\n\t\t\tIf Not d1.Exists(LCase(brr(i,1)) & \"\") then d1(LCase(brr(i,1)) & \"\") = brr(i,ml) & \"\"\r\n\t\t\tIf Not d2.Exists(LCase(brr(i,ml)) & \"\") then d2(LCase(brr(i,ml)) & \"\") = brr(i,1) & \"\"\r\n\t\tEnd If\t\r\n\tNext\r\nSet rng2 = application.inputbox(\"请选择保存结果的位置\",,,,,,,8)\r\nls = rng2.column - rng.column\r\nIf Not IsArray(rng) Then\r\n\tCall cz(rng)\r\nelse\t\r\n\tFor Each area In rng.specialcells(12).areas\r\n\t\tCall cz(area)\t\r\n\tNext\r\nEnd if\t\r\nSet application = Nothing\r\nSet sh = nothing\r\nset rng = Nothing\r\n\r\nSub cz(rng3)\t\r\n\t'开始匹配\r\n\tarr = rng3.value\r\n\tcrr = arr\r\n\tIf IsArray(arr) Then\r\n\t\tFor i = 1 To UBound(arr)\r\n\t\t\tIf ppfs = \"精确匹配\" then\r\n\t\t\t\tarr(i,1) = d1(arr(i,1) & \"\")\r\n\t\t\t\tcrr(i,1) = d2(crr(i,1) & \"\")\r\n\t\t\tElse\r\n\t\t\t\tarr(i,1) = d1(LCase(arr(i,1)) & \"\")\r\n\t\t\t\tcrr(i,1) = d2(LCase(crr(i,1)) & \"\")\r\n\t\t\tEnd If\r\n\t\t\tIf arr(i,1) = \"\" Then k1 = k1 + 1\r\n\t\t\tIf crr(i,1) = \"\" Then k2 = k2 + 1\r\n\t\tNext\r\n'\t\tSet rng3 = application.inputbox(\"请选择保存结果的位置\",,,,,,,8)\r\n\t\tIf k1 < k2 Then \r\n\t\t\trng3.offset(,ls).resize(UBound(arr),UBound(arr,2)).value = arr\r\n\t\tElse\r\n\t\t\trng3.offset(,ls).resize(UBound(crr),UBound(crr,2)).value = crr\r\n\t\tEnd If\t\r\n\tElse\r\n'\t\tSet rng3 = application.inputbox(\"请选择保存结果的位置\",,,,,,,8)\r\n\t\tIf ppfs = \"精确匹配\" then\r\n\t\t\tIf d1(arr & \"\") <> \"\" Then rng3.offset(,ls).value = d1(arr & \"\") Else rng3.offset(,ls).value = d2(arr & \"\")\r\n\t\tElse\r\n\t\t\tIf d1(LCase(arr) & \"\") <> \"\" Then rng3.offset(,ls).value = d1(LCase(arr) & \"\") Else rng3.offset(,ls).value = d2(LCase(arr) & \"\")\r\n\t\tEnd If\t\r\n\tEnd If\r\nEnd Sub\r\n\r\nsub xlookup()\r\nSet sourcerng = rng2.parent.usedrange\r\nSet rng2 = application.intersect(rng2,sourcerng)\r\nFor Each area In rng2.areas\r\n\tFor Each colrng In area.columns\r\n\t\tReDim Preserve colrr(k)\r\n\t\tcolrr(k) = colrng.column\r\n\t\tk = k + 1\r\n\tNext\r\nNext\r\narr = sourcerng.value\r\nrow1 = sourcerng.row:col1 = sourcerng.column\r\nrow2 = rng2.areas(1).row:rownum = rng2.areas(1).rows.count\r\nSet d = CreateObject(\"scripting.dictionary\")\r\nFor i = row2-row1+1 To row2+rownum-row1\r\n\ts = \"\"\r\n\tIf Not d.Exists(arr(i,colrr(0)-col1+1)) Then\r\n\t\tFor j = 1 To UBound(colrr)\r\n\t\t\ts = s & \"||\" & (arr(i,colrr(j)-col1+1))\r\n\t\tNext\r\n\t\td(arr(i,colrr(0)-col1+1)) = Mid(s,3)\r\n\tEnd If\r\nNext\r\nSet rng = rng.specialcells(12)\r\nSet rng2 = application.InputBox(\"请选择保存结果的位置\",\"Quicker提示！\",,,,,,8)\r\ncolnum = rng2.column-rng.column\r\nFor Each area In rng.areas\r\n\tjgrr = area.resize(area.rows.count+1,UBound(colrr)).value\r\n\tFor i = 1 To UBound(jgrr)\r\n\t\tIf d.Exists(jgrr(i,1)) Then\r\n\t\t\ttemprr = Split(d(jgrr(i,1)),\"||\")\r\n\t\t\tFor j = 0 To UBound(temprr)\r\n\t\t\t\tjgrr(i,j+1) = temprr(j)\r\n\t\t\tNext\r\n\t\tElse\r\n\t\t\tFor j = 1 To UBound(colrr)\r\n\t\t\t\tjgrr(i,j) = colrr(j)\r\n\t\t\tNext\r\n\t\tEnd If\r\n\tNext\r\n\tarea.offset(,colnum).resize(,UBound(colrr)).value = jgrr\r\nNext\r\nend sub\r\n\r\n\r\n\r\n\r\n"
"var:stdout": null,
]
我也看不懂！你自己研究下，看看是哪里被改
过了
京公网安备 11010502053266号
我一直回退到v7版本，都无法使用
可能你系统更新了还是啥的，脚本无法调用com接口，所以无法连接运行中的excel或者wps程序，很多人的系统有这问题，我也试过了真不知道怎么解决- -
我用ai修复了一下，现在可以用了。我现在把ai的答复发给你。
竟然能修复？是修改了什么
就是上面三个地方改了啊！下面是改完后的代码！
{
"LimitSingleInstance": true,
"SummaryExpression": "$$",
"SubPrograms": [
{
"Id": "3eed2165-c132-464a-926d-daf50edafc43",
"Icon": null,
"Name": "运行VBS脚本",
"Description": "",
"SummaryExpression": "$$",
"CreateTimeUtc": "2022-12-30T03:38:57.9632888Z",
"LastEditTimeUtc": "2022-12-30T04:09:49.555719+08:00",
"IsLocalEdited": false,
"Variables": [
{
"Key": "代码",
"IsLocked": false,
"Type": 0,
"Desc": "默认的文本变量",
"DefaultValue": "",
"SaveState": false,
"IsInput": true,
"IsOutput": false,
"ParamName": "",
"InputParamInfo": null,
"OutputParamInfo": null,
"TableDef": null,
"CustomType": null,
"Group": null
},
{
"Key": "stdout",
"IsLocked": false,
"Type": 0,
"Desc": "",
"DefaultValue": "",
"SaveState": false,
"IsInput": false,
"IsOutput": true,
"ParamName": "",
"InputParamInfo": null,
"OutputParamInfo": null,
"TableDef": null,
"CustomType": null,
"Group": null
},
{
"Key": "输出结果",
"IsLocked": false,
"Type": 2,
"Desc": "",
"DefaultValue": "false",
"SaveState": false,
"IsInput": true,
"IsOutput": false,
"ParamName": "",
"InputParamInfo": null,
"OutputParamInfo": null,
"TableDef": null,
"CustomType": null,
"Group": null
}
],
"Steps": [
{
"StepRunnerKey": "sys:if",
"InputParams": {
"condition": {
"VarKey": null,
"Value": "$= {输出结果} == true"
}
},
"OutputParams": {},
"IfSteps": [
{
"StepRunnerKey": "sys:runScript",
"InputParams": {
"script": {
"VarKey": "代码",
"Value": null
},
"type": {
"VarKey": null,
"Value": "CUSTOM"
},
"ext": {
"VarKey": null,
"Value": "VBS"
},
"encoding": {
"VarKey": null,
"Value": "utf-16"
},
"runner": {
"VarKey": null,
"Value": "Cscript"
},
"argTemplate": {
"VarKey": null,
"Value": "%FILE%"
},
"outputEncoding": {
"VarKey": null,
"Value": "oem"
},
"workingDir": {
"VarKey": null,
"Value": ""
},
"runAsAdmin": {
"VarKey": null,
"Value": "0"
},
"waitToExit": {
"VarKey": null,
"Value": "1"
}
},
"OutputParams": {
"stdout": "stdout",
"stderr": null
},
"IfSteps": null,
"ElseSteps": null,
"Note": "",
"Disabled": false,
"Collapsed": false,
"DelayMs": 0
},
{
"StepRunnerKey": "sys:strReplace",
"InputParams": {
"type": {
"VarKey": null,
"Value": "single"
},
"input": {
"VarKey": "stdout",
"Value": null
},
"old": {
"VarKey": null,
"Value": "Microsoft.*保留所有权利。"
},
"new": {
"VarKey": null,
"Value": ""
},
"escapeOld": {
"VarKey": null,
"Value": "true"
},
"replaceEscapes": {
"VarKey": null,
"Value": "true"
},
"useRegex": {
"VarKey": null,
"Value": "true"
},
"ignoreCase": {
"VarKey": null,
"Value": "true"
},
"singleLine": {
"VarKey": null,
"Value": "true"
},
"multiLine": {
"VarKey": null,
"Value": "false"
}
},
"OutputParams": {
"output": "stdout"
},
"IfSteps": null,
"ElseSteps": null,
"Note": "",
"Disabled": false,
"Collapsed": false,
"DelayMs": 0
},
{
"StepRunnerKey": "sys:stringProcess",
"InputParams": {
"data": {
"VarKey": "stdout",
"Value": null
},
"method": {
"VarKey": null,
"Value": "trim"
},
"stopIfFail": {
"VarKey": null,
"Value": "1"
}
},
"OutputParams": {
"output": "stdout",
"isSuccess": null
},
"IfSteps": null,
"ElseSteps": null,
"Note": "",
"Disabled": false,
"Collapsed": false,
"DelayMs": 0
}
],
"ElseSteps": [
{
"StepRunnerKey": "sys:runScript",
"InputParams": {
"script": {
"VarKey": "代码",
"Value": null
},
"type": {
"VarKey": null,
"Value": "CUSTOM"
},
"ext": {
"VarKey": null,
"Value": "VBS"
},
"encoding": {
"VarKey": null,
"Value": "utf-16"
},
"runner": {
"VarKey": null,
"Value": ""
},
"argTemplate": {
"VarKey": null,
"Value": "%FILE%"
},
"outputEncoding": {
"VarKey": null,
"Value": "oem"
},
"workingDir": {
"VarKey": null,
"Value": ""
},
"runAsAdmin": {
"VarKey": null,
"Value": "0"
},
"waitToExit": {
"VarKey": null,
"Value": "1"
}
},
"OutputParams": {
"stdout": null,
"stderr": null
},
"IfSteps": null,
"ElseSteps": null,
"Note": "",
"Disabled": false,
"Collapsed": false,
"DelayMs": 0
}
],
"Note": "",
"Disabled": false,
"Collapsed": false,
"DelayMs": 0
}
],
"SubPrograms": [],
"TemplateId": null,
"TemplateRevision": 0,
"UseServerVersion": null,
"IsProtected": null,
"SharedId": "e2489f51-b35d-472c-dc4b-08db3330aaec",
"ShareTimeUtc": "2023-04-03T07:58:01.9663857Z"
}
],
"Variables": [
{
"Key": "text",
"IsLocked": false,
"Type": 0,
"Desc": "默认的文本变量",
"DefaultValue": "",
"SaveState": false,
"IsInput": false,
"IsOutput": false,
"ParamName": null,
"InputParamInfo": null,
"OutputParamInfo": null,
"TableDef": null,
"CustomType": null,
"Group": null
},
{
"Key": "匹配方式",
"IsLocked": false,
"Type": 0,
"Desc": "",
"DefaultValue": "精确匹配",
"SaveState": false,
"IsInput": false,
"IsOutput": false,
"ParamName": "",
"InputParamInfo": null,
"OutputParamInfo": null,
"TableDef": null,
"CustomType": null,
"Group": null
}
],
"Steps": [
{
"StepRunnerKey": "sys:simpleIf",
"InputParams": {
"condition": {
"VarKey": null,
"Value": "$={quicker_in_param}==\"模糊匹配查找\""
}
},
"OutputParams": {},
"IfSteps": [
{
"StepRunnerKey": "sys:subprogram",
"InputParams": {
"subProgram": {
"VarKey": null,
"Value": "运行VBS脚本"
},
"var:代码": {
"VarKey": null,
"Value": "Dim application,sh,rng\r\nOn Error Resume Next\r\nSet application = GetObject(,\"excel.application\")\r\nIf application Is Nothing Then Set application = GetObject(,\"et.application\")\r\nIf application Is Nothing Then Set application = CreateObject(\"excel.application\")\r\nIf application Is Nothing Then Set application = CreateObject(\"et.application\")\r\nOn Error GoTo 0\r\nIf application Is Nothing Then\r\n MsgBox \"无法连接 Excel 或 WPS，请检查：\" & vbCrLf & \"1. 确认 Excel/WPS 已启动\" & vbCrLf & \"2. Excel/WPS 和 Quicker 使用相同权限运行\", vbExclamation, \"连接失败\"\r\n WScript.Quit\r\nEnd If\r\n\r\nIf application Is Nothing Then Set application = GetObject(,\"et.application\")\r\nIf application Is Nothing Then Set application = CreateObject(\"excel.application\")\r\nIf application Is Nothing Then Set application = CreateObject(\"et.application\")\r\nOn Error GoTo 0\r\nIf application Is Nothing Then\r\n MsgBox \"无法连接 Excel 或 WPS，请检查：\" & vbCrLf & \"1. 确认 Excel/WPS 已启动\" & vbCrLf & \"2. Excel/WPS 和 Quicker 使用相同权限运行\", vbExclamation, \"连接失败\"\r\n WScript.Quit\r\nEnd If\r\nSet sh = application.activesheet\r\nset rng = application.selection.specialcells(12)\r\nSet rng2 = application.InputBox(\"请选择数据源区域\" & vbCrLf & \"请确保查找值与查找结果在选择区域的两端\",\"Quicker提示！\",,,,,,8)\r\nSet sh2 = rng2.parent\r\nSet rng2 = application.intersect(rng2,sh2.usedrange)\r\narr = rng2.value2\r\nn = UBound(arr,2)\r\nSet d = CreateObject(\"scripting.dictionary\")\r\nSet d2 = CreateObject(\"scripting.dictionary\")\r\nFor i = 1 To UBound(arr)\r\n\td(CStr(arr(i,1))) = arr(i,n)\r\n\td2(CStr(arr(i,n))) = arr(i,1)\r\nNext\r\nSet rng2 = application.InputBox(\"请选择保存结果的位置\",\"Quicker提示！\",,,,,,8)\r\nrow = rng2.row:col = rng2.column\r\nrnum = row - rng.row:cnum = col - rng.column\r\nkeyrr1 = d.Keys\r\nkeyrr2 = d2.Keys\r\nFor Each area In rng.areas\r\n\tarr = area.resize(area.rows.count+1)\r\n\tjgrr1 = arr:jgrr2 = arr\r\n\tk1 = 0:k2 = 0\r\n\tFor i = 1 To UBound(arr)-1\r\n\t\tczz = CStr(arr(i,1))\r\n\t\ttemprr = Filter(keyrr1,czz)\r\n\t\tIf UBound(temprr) > -1 Then\t\t\r\n\t\t\tjgrr1(i,1) = d(temprr(0))\r\n\t\t\tk1 = k1 + 1\r\n\t\tElse\r\n\t\t\tjgrr1(i,1) = \"\"\r\n\t\tEnd If\r\n\t\t\r\n\t\ttemprr = Filter(keyrr2,czz)\r\n\t\tIf UBound(temprr) > -1 Then\t\t\r\n\t\t\tjgrr2(i,1) = d2(temprr(0))\r\n\t\t\tk2 = k2 + 1\r\n\t\tElse\r\n\t\t\tjgrr2(i,1) = \"\"\r\n\t\tEnd If\r\n\tNext\r\n\tIf k1 >= k2 Then\r\n\t\tarea(1).offset(rnum,cnum).resize(UBound(arr)-1).value = jgrr1\r\n\tElseIf k2 > k1 Then\r\n\t\tarea(1).offset(rnum,cnum).resize(UBound(arr)-1).value = jgrr2\r\n\tEnd If\t\r\nNext\r\n\r\n\r\nSet application = Nothing\r\nSet sh = nothing\r\nset rng = nothing"
},
"var:输出结果": {
"VarKey": null,
"Value": "false"
},
"stopIfFail": {
"VarKey": null,
"Value": "1"
},
"skipDebugOutput": {
"VarKey": null,
"Value": "1"
},
"summary": {
"VarKey": null,
"Value": ""
}
},
"OutputParams": {
"isSuccess": null,
"var:stdout": null
},
"IfSteps": null,
"ElseSteps": null,
"Note": "",
"Disabled": false,
"Collapsed": false,
"DelayMs": 0
},
{
"StepRunnerKey": "sys:stop",
"InputParams": {
"method": {
"VarKey": null,
"Value": "default"
},
"isError": {
"VarKey": null,
"Value": "0"
},
"return": {
"VarKey": null,
"Value": ""
},
"showMessage": {
"VarKey": null,
"Value": ""
}
},
"OutputParams": {},
"IfSteps": null,
"ElseSteps": null,
"Note": "",
"Disabled": false,
"Collapsed": false,
"DelayMs": 0
}
],
"ElseSteps": null,
"Note": "",
"Disabled": false,
"Collapsed": false,
"DelayMs": 0
},
{
"StepRunnerKey": "sys:simpleIf",
"InputParams": {
"condition": {
"VarKey": null,
"Value": "$={quicker_in_param}==\"查找近似值\""
}
},
"OutputParams": {},
"IfSteps": [
{
"StepRunnerKey": "sys:officehelper",
"InputParams": {
"operation": {
"VarKey": null,
"Value": "execVBA"
},
"appType": {
"VarKey": null,
"Value": "excel_et"
},
"code": {
"VarKey": null,
"Value": "Sub 查找近似值()\r\nDim rng As Range, rng2 As Range, d As Object\r\nDim i%, j%, k%, m%, s$, stra$, strb$, jgstr$\r\n\r\nSet rng = Selection\r\nSet rng = rng.SpecialCells(12)\r\nSet rng2 = Application.InputBox(\"请选择数据源\", \"Quicker提示！\", , , , , , 8)\r\narr = Application.Intersect(rng2, rng2.Parent.UsedRange).Value\r\nSet d = CreateObject(\"scripting.dictionary\")\r\nIf Application.CountA(rng.Offset(0, 1)) Then\r\n Set rng2 = Application.InputBox(\"请选择结果存放位置\", \"Quicker提示！\", , , , , , 8)\r\n col = rng2.Column - rng.Column\r\nElse\r\n col = 1\r\nEnd If\r\nFor Each rn In rng.Areas\r\n jgrr = rn.Resize(rn.Rows.Count + 1, 1).Value\r\n For i = 1 To UBound(jgrr) - 1\r\n stra = jgrr(i, 1)\r\n jgstr = \"\"\r\n n = -1\r\n For j = 1 To UBound(arr)\r\n strb = arr(j, 1)\r\n m = 0\r\n For k = 1 To Len(stra)\r\n s = Mid(stra, k, 1)\r\n If s <> \" \" Then\r\n If InStr(strb, s) Then\r\n m = m + 1\r\n strb = Replace(strb, s, \"\", , 1)\r\n End If\r\n End If\r\n Next k\r\n If m > n Then\r\n jgstr = arr(j, 1)\r\n n = m\r\n ElseIf m = n Then\r\n jgstr = jgstr & \"\\/\" & arr(j, 1)\r\n End If\r\n Next j\r\n If InStr(jgstr, \"\\/\") Then\r\n temprr = Split(jgstr, \"\\/\")\r\n For k = 0 To UBound(temprr)\r\n temprr(k) = k + 1 & \":\" & temprr(k)\r\n Next\r\n jgstr = \"请手动选择【\" & stra & \"】的最近似值。\" & vbCrLf & Join(temprr, vbCrLf)\r\n k = Application.InputBox(jgstr, \"Quicker提示！\", , , , , , 1)\r\n If k > UBound(temprr) + 1 Then '如果选择的序号超出范围则返回一个空值\r\n jgrr(i, 1) = \"\"\r\n Else\r\n jgstr = temprr(k - 1)\r\n jgstr = Mid(jgstr, InStr(jgstr, \":\") + 1)\r\n jgrr(i, 1) = jgstr\r\n End If\r\n Else\r\n jgrr(i, 1) = jgstr\r\n End If\r\n Next i\r\n rn.Offset(0, col).Value = jgrr\r\nNext\r\nEnd Sub\r\n"
},
"waitResp": {
"VarKey": null,
"Value": "0"
},
"stopIfFail": {
"VarKey": null,
"Value": "1"
},
"waitMs": {
"VarKey": null,
"Value": "0"
}
},
"OutputParams": {
"isSuccess": null,
"resp": null,
"errMessage": null
},
"IfSteps": null,
"ElseSteps": null,
"Note": "",
"Disabled": false,
"Collapsed": false,
"DelayMs": 0
},
{
"StepRunnerKey": "sys:stop",
"InputParams": {
"method": {
"VarKey": null,
"Value": "default"
},
"isError": {
"VarKey": null,
"Value": "0"
},
"return": {
"VarKey": null,
"Value": ""
},
"showMessage": {
"VarKey": null,
"Value": ""
}
},
"OutputParams": {},
"IfSteps": null,
"ElseSteps": null,
"Note": "",
"Disabled": false,
"Collapsed": false,
"DelayMs": 0
}
],
"ElseSteps": null,
"Note": "",
"Disabled": false,
"Collapsed": false,
"DelayMs": 0
},
{
"StepRunnerKey": "sys:if",
"InputParams": {
"condition": {
"VarKey": null,
"Value": "$={quicker_in_param}==\"区分\""
}
},
"OutputParams": {},
"IfSteps": [
{
"StepRunnerKey": "sys:assign",
"InputParams": {
"input": {
"VarKey": null,
"Value": "精确匹配"
},
"stopIfFail": {
"VarKey": null,
"Value": "1"
}
},
"OutputParams": {
"isSuccess": null,
"output": "匹配方式"
},
"IfSteps": null,
"ElseSteps": null,
"Note": "",
"Disabled": false,
"Collapsed": false,
"DelayMs": 0
}
],
"ElseSteps": [
{
"StepRunnerKey": "sys:assign",
"InputParams": {
"input": {
"VarKey": null,
"Value": "其它"
},
"stopIfFail": {
"VarKey": null,
"Value": "1"
}
},
"OutputParams": {
"isSuccess": null,
"output": "匹配方式"
},
"IfSteps": null,
"ElseSteps": null,
"Note": "",
"Disabled": false,
"Collapsed": false,
"DelayMs": 0
}
],
"Note": "",
"Disabled": false,
"Collapsed": true,
"DelayMs": 0
},
{
"StepRunnerKey": "sys:subprogram",
"InputParams": {
"subProgram": {
"VarKey": null,
"Value": "运行VBS脚本"
},
"var:代码": {
"VarKey": null,
"Value": "$$'查找方式：查找首个符合条件的值;匹配方式：精确匹配或者不区分大小写\r\nDim application,sh,rng\r\nOn Error Resume Next\r\nSet application = GetObject(,\"excel.application\")\r\nIf application Is Nothing Then Set application = GetObject(,\"et.application\")\r\nIf application Is Nothing Then Set application = CreateObject(\"excel.application\")\r\nIf application Is Nothing Then Set application = CreateObject(\"et.application\")\r\nOn Error GoTo 0\r\nIf application Is Nothing Then\r\n MsgBox \"无法连接 Excel 或 WPS，请检查：\" & vbCrLf & \"1. 确认 Excel/WPS 已启动\" & vbCrLf & \"2. Excel/WPS 和 Quicker 使用相同权限运行\", vbExclamation, \"连接失败\"\r\n WScript.Quit\r\nEnd If\r\n\r\nIf application Is Nothing Then Set application = GetObject(,\"et.application\")\r\nIf application Is Nothing Then Set application = CreateObject(\"excel.application\")\r\nIf application Is Nothing Then Set application = CreateObject(\"et.application\")\r\nOn Error GoTo 0\r\nIf application Is Nothing Then\r\n MsgBox \"无法连接 Excel 或 WPS，请检查：\" & vbCrLf & \"1. 确认 Excel/WPS 已启动\" & vbCrLf & \"2. Excel/WPS 和 Quicker 使用相同权限运行\", vbExclamation, \"连接失败\"\r\n WScript.Quit\r\nEnd If\r\nSet sh = application.activesheet\r\nset rng = application.selection\r\nIf rng.columns.count > 1 Then Set rng = rng.resize(,1)\r\n\r\nppfs = \"{匹配方式}\"\r\n\r\non error resume next\r\nSet rng2 = application.inputbox(\"请选择数据源区域,注意查找值和结果在区域两端\" & vbcrlf & \"或者先选择查找值所在列后按住CTRL键选择需要返回的结果列\",,,,,,,8)\r\nif err then WScript.Quit\r\nif rng2.areas.count>1 then\r\n\tcall xlookup\r\n\twscript.quit\r\nend if\r\nSet rng2 = application.intersect(rng2,rng2.parent.usedrange)\r\n'写入字典\r\n\tbrr = rng2.value\r\n\tml = UBound(brr,2)\r\n\tSet d1 = CreateObject(\"scripting.dictionary\")\r\n\tSet d2 = CreateObject(\"scripting.dictionary\")\r\n\t'创建两个字典\r\n\tFor i = 1 To UBound(brr)\r\n\t\tIf ppfs = \"精确匹配\" then\r\n\t\t\tIf Not d1.Exists(brr(i,1) & \"\") then d1(brr(i,1) & \"\") = brr(i,ml) & \"\"\r\n\t\t\tIf Not d2.Exists(brr(i,ml) & \"\") then d2(brr(i,ml) & \"\") = brr(i,1) & \"\"\r\n\t\tElse\r\n\t\t\tIf Not d1.Exists(LCase(brr(i,1)) & \"\") then d1(LCase(brr(i,1)) & \"\") = brr(i,ml) & \"\"\r\n\t\t\tIf Not d2.Exists(LCase(brr(i,ml)) & \"\") then d2(LCase(brr(i,ml)) & \"\") = brr(i,1) & \"\"\r\n\t\tEnd If\t\r\n\tNext\r\nSet rng2 = application.inputbox(\"请选择保存结果的位置\",,,,,,,8)\r\nls = rng2.column - rng.column\r\nIf Not IsArray(rng) Then\r\n\tCall cz(rng)\r\nelse\t\r\n\tFor Each area In rng.specialcells(12).areas\r\n\t\tCall cz(area)\t\r\n\tNext\r\nEnd if\t\r\nSet application = Nothing\r\nSet sh = nothing\r\nset rng = Nothing\r\n\r\nSub cz(rng3)\t\r\n\t'开始匹配\r\n\tarr = rng3.value\r\n\tcrr = arr\r\n\tIf IsArray(arr) Then\r\n\t\tFor i = 1 To UBound(arr)\r\n\t\t\tIf ppfs = \"精确匹配\" then\r\n\t\t\t\tarr(i,1) = d1(arr(i,1) & \"\")\r\n\t\t\t\tcrr(i,1) = d2(crr(i,1) & \"\")\r\n\t\t\tElse\r\n\t\t\t\tarr(i,1) = d1(LCase(arr(i,1)) & \"\")\r\n\t\t\t\tcrr(i,1) = d2(LCase(crr(i,1)) & \"\")\r\n\t\t\tEnd If\r\n\t\t\tIf arr(i,1) = \"\" Then k1 = k1 + 1\r\n\t\t\tIf crr(i,1) = \"\" Then k2 = k2 + 1\r\n\t\tNext\r\n'\t\tSet rng3 = application.inputbox(\"请选择保存结果的位置\",,,,,,,8)\r\n\t\tIf k1 < k2 Then \r\n\t\t\trng3.offset(,ls).resize(UBound(arr),UBound(arr,2)).value = arr\r\n\t\tElse\r\n\t\t\trng3.offset(,ls).resize(UBound(crr),UBound(crr,2)).value = crr\r\n\t\tEnd If\t\r\n\tElse\r\n'\t\tSet rng3 = application.inputbox(\"请选择保存结果的位置\",,,,,,,8)\r\n\t\tIf ppfs = \"精确匹配\" then\r\n\t\t\tIf d1(arr & \"\") <> \"\" Then rng3.offset(,ls).value = d1(arr & \"\") Else rng3.offset(,ls).value = d2(arr & \"\")\r\n\t\tElse\r\n\t\t\tIf d1(LCase(arr) & \"\") <> \"\" Then rng3.offset(,ls).value = d1(LCase(arr) & \"\") Else rng3.offset(,ls).value = d2(LCase(arr) & \"\")\r\n\t\tEnd If\t\r\n\tEnd If\r\nEnd Sub\r\n\r\nsub xlookup()\r\nSet sourcerng = rng2.parent.usedrange\r\nSet rng2 = application.intersect(rng2,sourcerng)\r\nFor Each area In rng2.areas\r\n\tFor Each colrng In area.columns\r\n\t\tReDim Preserve colrr(k)\r\n\t\tcolrr(k) = colrng.column\r\n\t\tk = k + 1\r\n\tNext\r\nNext\r\narr = sourcerng.value\r\nrow1 = sourcerng.row:col1 = sourcerng.column\r\nrow2 = rng2.areas(1).row:rownum = rng2.areas(1).rows.count\r\nSet d = CreateObject(\"scripting.dictionary\")\r\nFor i = row2-row1+1 To row2+rownum-row1\r\n\ts = \"\"\r\n\tIf Not d.Exists(arr(i,colrr(0)-col1+1)) Then\r\n\t\tFor j = 1 To UBound(colrr)\r\n\t\t\ts = s & \"||\" & (arr(i,colrr(j)-col1+1))\r\n\t\tNext\r\n\t\td(arr(i,colrr(0)-col1+1)) = Mid(s,3)\r\n\tEnd If\r\nNext\r\nSet rng = rng.specialcells(12)\r\nSet rng2 = application.InputBox(\"请选择保存结果的位置\",\"Quicker提示！\",,,,,,8)\r\ncolnum = rng2.column-rng.column\r\nFor Each area In rng.areas\r\n\tjgrr = area.resize(area.rows.count+1,UBound(colrr)).value\r\n\tFor i = 1 To UBound(jgrr)\r\n\t\tIf d.Exists(jgrr(i,1)) Then\r\n\t\t\ttemprr = Split(d(jgrr(i,1)),\"||\")\r\n\t\t\tFor j = 0 To UBound(temprr)\r\n\t\t\t\tjgrr(i,j+1) = temprr(j)\r\n\t\t\tNext\r\n\t\tElse\r\n\t\t\tFor j = 1 To UBound(colrr)\r\n\t\t\t\tjgrr(i,j) = colrr(j)\r\n\t\t\tNext\r\n\t\tEnd If\r\n\tNext\r\n\tarea.offset(,colnum).resize(,UBound(colrr)).value = jgrr\r\nNext\r\nend sub\r\n\r\n\r\n\r\n\r\n"
},
"var:输出结果": {
"VarKey": null,
"Value": "false"
},
"stopIfFail": {
"VarKey": null,
"Value": "1"
},
"skipDebugOutput": {
"VarKey": null,
"Value": "false"
},
"summary": {
"VarKey": null,
"Value": ""
}
},
"OutputParams": {
"isSuccess": null,
"var:stdout": null,
"errMessage": null
},
"IfSteps": null,
"ElseSteps": null,
"Note": "",
"Disabled": false,
"Collapsed": false,
"DelayMs": 0
}
]
}
我也看不懂！你自己研究下，看看是哪里被改
过了