VBA如何快速将每一行的第一个序号删除

喝酒的毛毛虫 · 发表于 2023-1-30 21:02

本帖最后由喝酒的毛毛虫于 2023-1-30 21:35 编辑

QQ截图20230130210020.jpg

如图，如何使用VBA的方式将前面的序号1.、2.、3.、……等需要删除，使用函数公式可以实现，但是我想用VBA的方式去做，因为需要做大量重复的工作，使用宏就比较方便一些。是否有VB代码可以实现批量删除每一行第一个数字序号呢？（因为有些行可能是多个数字序号的，如某一行显示：1.姓名.张三.X.李四，我只要删除1.即可）请高手支招，非常感谢。

shiruiqiang · 发表于 2023-1-30 21:17

本帖最后由 shiruiqiang 于 2023-1-30 21:24 编辑

直接替换"*."试试，vba里也可以吧，如果有多个"."的话，下面老师有说明

喝酒的毛毛虫 · 发表于 2023-1-30 21:20

shiruiqiang 发表于 2023-1-30 21:17
直接替换"*."试试，vba里也可以吧

可以是可以，但是如果每一行后面还有序号也会被删，我要实现的是第一个序号删除

wang-way · 发表于 2023-1-30 21:22

split(cells(i,1),".")(1)

leolee82 · 发表于 2023-1-31 01:30

自已ExcelDIY工具中的代码，里面CreateObject("ExDIY.F")相关的函数都是比较基础的，自己重新实现下就好。

'X:在文本中搜索的内容
'iIndexOfX:从第几个X处开始
'iNumToDelete:删除字符的数量
'bFromTop:删除的方向,向前或向后
'bReverseSearch:是否逆向搜索
Sub RemoveTextByContents(WorkRange As Range, x$, iIndexOfX As Long, iNumToDelete As Long, bFromTop As Boolean, bReverseSearch As Boolean, _
Optional bModifyFormula As Boolean, Optional bOmitHiddenCell As Boolean)
Dim a As Range
Dim CellCount As Long
Dim TotalCells As Long
Dim item As Range
Dim BeginPosition As Long
Dim iLenX As Long, iLenS As Long
Dim iNum As Long
iLenX = Len(x)
Dim sht As Worksheet, arr
For Each sht In ActiveWindow.SelectedSheets
For Each item In CreateObject("ExDIY.F").GetValidRange(sht.Range(WorkRange.Address), bOmitHiddenCell).Areas
If bModifyFormula Then
arr = CreateObject("ExDIY.F").Range2Array(item, "Formula")
Else
arr = CreateObject("ExDIY.F").Range2Array(item)
End If
For i = LBound(arr, 1) To UBound(arr, 1)
For j = LBound(arr, 2) To UBound(arr, 2)
arr(i, j) = CStr(arr(i, j))
iLenS = Len(arr(i, j))
If iLenS = 0 Then GoTo Nexta
'搜索X位置
If bReverseSearch Then
BeginPosition = CreateObject("ExDIY.F").InstrExRev(CStr(arr(i, j)), x, iIndexOfX)
Else
BeginPosition = CreateObject("ExDIY.F").InstrEx(CStr(arr(i, j)), x, iIndexOfX)
End If
'计算开始位置
Dim iNumToDelete_ As Long
If BeginPosition Then
If bFromTop Then
If BeginPosition < iLenS Then
If iLenS - BeginPosition - iLenX - iNumToDelete + 1 < 0 Then
iNumToDelete_ = iLenS - BeginPosition - iLenX + 1
Else
iNumToDelete_ = iNumToDelete
End If
arr(i, j) = Left(arr(i, j), BeginPosition + iLenX - 1) & Right(arr(i, j), iLenS - BeginPosition - iLenX - iNumToDelete_ + 1)
End If
Else
If BeginPosition > 1 Then
If BeginPosition - iNumToDelete - 1 < 0 Then
iNumToDelete_ = BeginPosition - 1
Else
iNumToDelete_ = iNumToDelete
End If
arr(i, j) = Left(arr(i, j), BeginPosition - iNumToDelete_ - 1) & Right(arr(i, j), iLenS - BeginPosition + 1)
End If
End If
End If
Nexta:
Next j
Next i
CreateObject("ExDIY.F").FillRange item, arr
Next item
Next sht
End Sub

复制代码

leolee82 · 发表于 2023-1-31 01:53

自己ExcelDIY中的一个工具，与楼主相关的代码如下，CreateObject("ExDIY.F")中的函数都是比较基础的，自己写下替换掉就好

'X:在文本中搜索的内容
'iIndexOfX:从第几个X处开始
'iNumToDelete:删除字符的数量
'bFromTop:删除的方向,向前或向后
'bReverseSearch:是否逆向搜索
Sub RemoveTextByContents(WorkRange As Range, x$, iIndexOfX As Long, iNumToDelete As Long, bFromTop As Boolean, bReverseSearch As Boolean, _
Optional bModifyFormula As Boolean, Optional bOmitHiddenCell As Boolean)
Dim a As Range
Dim CellCount As Long
Dim TotalCells As Long
Dim item As Range
Dim BeginPosition As Long
Dim iLenX As Long, iLenS As Long
Dim iNum As Long
iLenX = Len(x)
Dim sht As Worksheet, arr
For Each sht In ActiveWindow.SelectedSheets
For Each item In CreateObject("ExDIY.F").GetValidRange(sht.Range(WorkRange.Address), bOmitHiddenCell).Areas
If bModifyFormula Then
arr = CreateObject("ExDIY.F").Range2Array(item, "Formula")
Else
arr = CreateObject("ExDIY.F").Range2Array(item)
End If
For i = LBound(arr, 1) To UBound(arr, 1)
For j = LBound(arr, 2) To UBound(arr, 2)
arr(i, j) = CStr(arr(i, j))
iLenS = Len(arr(i, j))
If iLenS = 0 Then GoTo Nexta
'搜索X位置
If bReverseSearch Then
BeginPosition = CreateObject("ExDIY.F").InstrExRev(CStr(arr(i, j)), x, iIndexOfX)
Else
BeginPosition = CreateObject("ExDIY.F").InstrEx(CStr(arr(i, j)), x, iIndexOfX)
End If
'计算开始位置
Dim iNumToDelete_ As Long
If BeginPosition Then
If bFromTop Then
If BeginPosition < iLenS Then
If iLenS - BeginPosition - iLenX - iNumToDelete + 1 < 0 Then
iNumToDelete_ = iLenS - BeginPosition - iLenX + 1
Else
iNumToDelete_ = iNumToDelete
End If
arr(i, j) = Left(arr(i, j), BeginPosition + iLenX - 1) & Right(arr(i, j), iLenS - BeginPosition - iLenX - iNumToDelete_ + 1)
End If
Else
If BeginPosition > 1 Then
If BeginPosition - iNumToDelete - 1 < 0 Then
iNumToDelete_ = BeginPosition - 1
Else
iNumToDelete_ = iNumToDelete
End If
arr(i, j) = Left(arr(i, j), BeginPosition - iNumToDelete_ - 1) & Right(arr(i, j), iLenS - BeginPosition + 1)
End If
End If
End If
Nexta:
Next j
Next i
CreateObject("ExDIY.F").FillRange item, arr
Next item
Next sht
End Sub

复制代码

fzxba · 发表于 2023-1-31 11:42

sub test
dim cel as range,j as integer
for each cel in range("A1:A" & cells(rows.count,"A").end(xlup).row)
j=instr(cel.value,".")
if j then cel.value=mid(cel.value,j+1)
next
end sub

喝酒的毛毛虫 · 发表于 2023-1-31 18:32

别沉呀，还没解决呢

tanglf188 · 发表于 2023-1-31 18:48

以A列为例
Columns("A:A").Replace What:="*.", Replacement:="", LookAt:=xlPart, SearchFormat:=False

喝酒的毛毛虫 · 发表于 2023-1-31 19:59

tanglf188 发表于 2023-1-31 18:48
以A列为例
Columns("A:A").Replace What:="*.", Replacement:="", LookAt:=xlPart, SearchFormat:=False

删除每一行第一个数字序号呢？（因为有些行可能是多个数字序号的，如某一行显示：1.姓名.张三.X.李四，我只要删除1.即可）

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

[求助] VBA如何快速将每一行的第一个序号删除

评分