Stu*_*919 3 excel vba excel-vba excel-addins
我试图在一个excel插件中添加功能,这个插件正在开发,它修剪了在使用过的单元格末尾的前导空格,甚至可能解析文本,我需要这样做的原因只是让它变成一个超链接我已经工作但是这部分很好.
这是我到目前为止所尝试的,我有它修剪active.worksheet我很好,但我无法弄清楚如何:
这是我尝试修剪整个工作簿,它只是简单的我知道它,我只是想弄清楚:
Sub DoTrim(Wb As Workbook)
Dim cell As Range
Dim str As String
Dim nAscii As Integer
Dim wsh As Worksheet
For Each wsh In Worksheets
With wsh.UsedRange
For Each cell In ActiveSheet.UsedRange
str = Trim(cell)
If Len(str) > 0 Then
nAscii = Asc(Left(str, 1))
If nAscii < 33 Or nAscii = 160 Then
If Len(str) > 1 Then
str = Right(str, Len(str) - 1)
Else
str = ""
End If
End If
End If
cell = str
Next cell
End With
Next wsh
End Sub
Run Code Online (Sandbox Code Playgroud)
如果我听起来像一个完整的Newb,那么任何建议都会受到欢迎.
TL; DR修剪单元格只有工作表,需要在整个工作簿中运行我无法弄清楚如何在整个工作中迭代它.
编辑:这也是修剪这些细胞的一种更快的方法,为我们设计的电子表格很大,需要一段时间来修剪细胞
未经测试
这是你在尝试什么?
Sub DoTrim(Wb As Workbook)
Dim aCell As Range
Dim wsh As Worksheet
'~~> If you are using it in an Add-In, it is advisable
'~~> to keep the user posted :)
Application.StatusBar = "Processing Worksheets... Please do not disturb..."
DoEvents
Application.ScreenUpdating = False
For Each wsh In Wb.Worksheets
With wsh
Application.StatusBar = "Processing Worksheet " & _
.Name & ". Please do not disturb..."
DoEvents
For Each aCell In .UsedRange
If Not aCell.Value = "" And aCell.HasFormula = False Then
With aCell
.Value = Replace(.Value, Chr(160), "")
.Value = Application.WorksheetFunction.Clean(.Value)
.Value = Trim(.Value)
End With
End If
Next aCell
End With
Next wsh
Application.ScreenUpdating = True
Application.StatusBar = "Done"
End Sub
Run Code Online (Sandbox Code Playgroud)
我同意Siddarth:
For Each cell In ActiveSheet.UsedRange
Run Code Online (Sandbox Code Playgroud)
应该:
For Each cell In wsh.UsedRange
Run Code Online (Sandbox Code Playgroud)
我原以为你应该能够在循环中使用'With wsh.UsedRange'语句删除.
当你传递一个WorkBook引用时,也许你应该考虑改变你的外部For循环:
For Each wsh In Worksheets
Run Code Online (Sandbox Code Playgroud)
至:
For Each wsh In Wb.Worksheets
Run Code Online (Sandbox Code Playgroud)