(感谢Ib_bn老师！问题已解决！) 想用VBA去掉末尾空格

xj9696

Sub tset()
Dim rng As Range, c As Range
Dim RegEx As New RegExp
Set rng = UsedRange
With RegEx
    .Global = True
    .IgnoreCase = True
    .Pattern = "\s+(00)*"
    For Each c In rng
        c = .Replace(c.Value, "")
    Next
End With
End Sub

cflood

把数据读到数组中速度超快

tommyszeto

原帖由 cflood 于 2010-4-8 14:50 发表
把数据读到数组中速度超快

程序執行時, 有錯誤信息的顯示。
untitled.zip (21.17 KB, 下载次数: 9)

2010-4-8 16:20 上传

点击文件名下载附件

請修正, 謝謝您!

tommyszeto

Hi 懇請幫忙修改如下！

請求:
- 想在sheet1加上按鈕；按制後從視窗內輸入揀選指定的檔案去執行指令
- 字體後有空格, 去掉末尾的空格
- 但遇上空格後末端有00的字樣，請刪除00及除去尾隨的空格
- 只有空格而沒有字體，請除去空格
- 要保持日期的格式不變
- 若有函數公式，請保留

lb_bn

试试这个.

Sub bbb()
    Dim i&, ii&, tmp$, s, arr1()
   
    arr1 = [a7].Resize([a65536].End(3).Row - 6, 13).Value
    For i = 1 To UBound(arr1)
        For ii = 1 To UBound(arr1, 2)
            tmp = arr1(i, ii)
            If Len(tmp) Then
                s = Split(tmp)
                If UBound(s) Then
                    arr1(i, ii) = s(0)
                End If
            End If
        Next
    Next
    [d7].Resize(UBound(arr1)).NumberFormatLocal = "@"
    [a7].Resize(UBound(arr1), 13).Value = arr1
End Sub

tommyszeto

原帖由 lb_bn 于 2010-4-10 19:10 发表
试试这个.

Sub bbb()
    Dim i&, ii&, tmp$, s, arr1()
   
    arr1 = [a7].Resize([a65536].End(3).Row - 6, 13).Value
    For i = 1 To UBound(arr1)
        For ii = 1 To UBound(arr1, 2)
        ...

您好lb_bn:
但串連之空格後的字體也去掉了，例如：
同一方格內：AAA BBB CCC (原有)
進行程式後：AAA (變更為)

有方法解決嗎？謝謝你！

lb_bn

楼主多上传点数据以方便测试吧.

lb_bn

1. Sub bbb()
   
2.     Dim i&, ii&, tmp$, s, arr1()
   
3. 
   
4.     arr1 = [a7].Resize([a65536].End(3).Row - 6, 13).Value
   
5.     For i = 1 To UBound(arr1)
   
6.         For ii = 1 To UBound(arr1, 2)
   
7.             tmp = arr1(i, ii)
   
8.             If Len(tmp) Then
   
9.                 If ii = 1 Then
   
10.                     s = Split(tmp)
    
11.                     If UBound(s) Then
    
12.                         arr1(i, ii) = s(0)
    
13.                     End If
    
14.                 Else
    
15.                     arr1(i, ii) = WorksheetFunction.Trim(tmp)
    
16.                 End If
    
17.             End If
    
18.         Next
    
19.     Next
    
20.     [d7].Resize(UBound(arr1)).NumberFormatLocal = "@"
    
21.     [a7].Resize(UBound(arr1), 13).Value = arr1
    
22. End Sub

复制代码

再试试.

tommyszeto

您好lb_bn:
這麼晚也能夠幫助我，我真的不好意思了。
試過運行程式，超極速，還可以保留原有日期的格式不變，但請問還可以保留函數公式嗎？
此外，因為我是剛來學習，可以簡單地解釋內裡的結構呀？

謝謝你！

lb_bn

1. Sub bbb()
   
2.     Dim i&, ii&, tmp$, s, arr1()
   
3. 
   
4.     arr1 = [a7].Resize([a65536].End(3).Row - 6, 13).Formula
   
5.     For i = 1 To UBound(arr1)
   
6.         For ii = 1 To UBound(arr1, 2)
   
7.             tmp = arr1(i, ii)
   
8.             If Len(tmp) Then
   
9.                 If Not tmp Like "=*" Then
   
10.                     If ii = 1 Then
    
11.                         s = Split(tmp)
    
12.                         If UBound(s) Then
    
13.                             arr1(i, ii) = s(0)
    
14.                         End If
    
15.                     Else
    
16.                         arr1(i, ii) = WorksheetFunction.Trim(tmp)
    
17.                     End If
    
18.                 End If
    
19.             End If
    
20.         Next
    
21.     Next
    
22.     [d7].Resize(UBound(arr1)).NumberFormatLocal = "@"
    
23.     [a7].Resize(UBound(arr1), 13).Value = arr1
    
24. End Sub

复制代码

试试
就是将区域数据放到数组里,然后循环处理所有的数据.