删除特定位置本文问题

喝酒的毛毛虫

需要删除每一行特定位置的文本，请无所不能的高手查阅附件，谢谢。 删除文本开头特定文本问题.rar (16.73 KB, 下载次数: 13)

2023-2-9 11:00 上传

点击文件名下载附件

cjc209

这个智能填充就可以

喝酒的毛毛虫

cjc209 发表于 2023-2-9 10:27
这个智能填充就可以

想用VBA配合其他功能一键完成，谢谢老师。

cjc209

这样 vba方法  

ykcbf1100

参与一下。

喝酒的毛毛虫

ykcbf1100 发表于 2023-2-9 11:19
参与一下。

老师好，第13行的张三也被删了，其他没问题

ykcbf1100

喝酒的毛毛虫 发表于 2023-2-9 11:21
老师好，第13行的张三也被删了，其他没问题

13行不符合你说的情况，就容易误删。

ykcbf1100

喝酒的毛毛虫 发表于 2023-2-9 11:21
老师好，第13行的张三也被删了，其他没问题

增加一个判断，这个代码能满足你的要求。

喝酒的毛毛虫

ykcbf1100 发表于 2023-2-9 12:03
增加一个判断，这个代码能满足你的要求。

感谢老师，非常完美。今天还没有鲜花，有鲜花再给您送。

tanglf188

1. Sub delestr()
   
2.     st1 = "一二三四五六七八九十"
   
3.     st2 = "、。."
   
4.     For i = 1 To 13
   
5.         st3 = Cells(i, "A")
   
6.         Do
   
7.             If InStr(st2, Left(st3, 1)) > 0 Then
   
8.                 st3 = Mid(st3, 2, Len(st3) - 1)
   
9.             Else
   
10.                 'Cells(i, "D") = st3
    
11.                 Exit Do
    
12.             End If
    
13.         Loop
    
14.         For j = 1 To 3
    
15.             If InStr(st1, Left(st3, 1)) > 0 Then
    
16.                 dp = InStr(st3, Mid(st2, j, 1))
    
17.                 If dp > 0 Then
    
18.                     st3 = Mid(st3, dp + 1, Len(st3) - dp)
    
19.                 End If
    
20.             End If
    
21.             Cells(i, "D") = st3
    
22.         Next
    
23.     Next
    
24. End Sub
    

复制代码