求助一个关于VBA执行顺序的问题

TB肥仔 · 发表于 2019-1-22 21:36

我想要做的是将A列中带有指定字符串的，提取到B列中，并且判断，如果B列值为空则删除当前这一列。并且删除B列的重复值

但是，不知道是什么原因，如果B列值为空则删除当前这一列，这个语句没有执行。有大侠可以给点帮助吗

TB肥仔 · 发表于 2019-1-23 09:36

是不是把x设置为全局变量，执行完一次查找后，call一次删除就行

LSL1128xgw · 发表于 2019-1-23 10:55

复制代码

k m列数据自己调整位置。

lsdongjh · 发表于 2019-1-23 11:46

Sub Test()
Dim shSource As Worksheet, shResult As Worksheet
Dim arr As Variant, objDic As Object
Dim strTemp As String, strKey As String
Dim objReg As Object, objMatchs As Object, objMatch As Object
Set shSource = Sheets("实际运行结果")
Set shResult = Sheets("想要的结果")
Set objDic = CreateObject("Scripting.Dictionary")
arr = shSource.UsedRange
arr = Application.WorksheetFunction.Index(arr, 0, 1)
arr = Application.WorksheetFunction.Transpose(arr)
strTemp = Join(arr, vbCrLf)
Set objReg = CreateObject("VBScript.RegExp")
With objReg
.Global = True
.Pattern = ".*?([0-9A-z\-]+\.edf).*"
End With
Set objMatchs = objReg.Execute(strTemp)
For Each objMatch In objMatchs
strKey = objMatch.subMatches(0)
If Not objDic.Exists(strKey) Then
objDic(strKey) = objMatch
End If
Next
shResult.Range("A1").Resize(objDic.Count, 1) = Application.WorksheetFunction.Transpose(objDic.items)
shResult.Range("B1").Resize(objDic.Count, 1) = Application.WorksheetFunction.Transpose(objDic.keys)
End Sub

复制代码

TB肥仔 · 发表于 2019-1-23 14:14

lsdongjh 发表于 2019-1-23 11:46

你的这个语句我看的不是很明白

lsdongjh · 发表于 2019-1-23 14:15

TB肥仔发表于 2019-1-23 14:14
你的这个语句我看的不是很明白

正则分组捕获

TB肥仔 · 发表于 2019-1-23 14:34

lsdongjh 发表于 2019-1-23 14:15
正则分组捕获

这样啊，但是你的这个不能运行啊

lsdongjh · 发表于 2019-1-23 14:36

TB肥仔发表于 2019-1-23 14:34
这样啊，但是你的这个不能运行啊

你把附件中 “想要的结果” 这张有清空，再运行一下看看？

TB肥仔 · 发表于 2019-1-23 14:54

lsdongjh 发表于 2019-1-23 14:36
你把附件中 “想要的结果” 这张有清空，再运行一下看看？

cl列的数据也是有用处的，这个可以加进去吗

lsdongjh · 发表于 2019-1-23 15:09

TB肥仔发表于 2019-1-23 14:54
cl列的数据也是有用处的，这个可以加进去吗

你的D列数据不是一个内容吗？自己填充一下就行啊

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

[求助] 求助一个关于VBA执行顺序的问题