如何在VBA中修剪一个很长的字符串? [英] How to worksheetfunction.Trim a very long string in VBA?

问题描述

我知道问这个问题很奇怪.但是我所面对的并不奇怪.

I know it's weird asking this question. But what I am facing is not less weird.

我有一些长字符串(大约1000个字符或更多-更新:对不起，不是1000，但是大约39000，我的错).它们包含我要修剪的空间.

I have some long strings (About 1000 chars or more -- Update: Sorry, not 1000, but around 39000, my bad) . They contain spaces which I want to trim.

根据常识，我使用Worksheetfunction.Trim来完成这项工作.它使用了一些短字符串(大约500个字符).但是，随着字符串变大(超过39000个字符)，它不断返回错误'1004' - unable to get trim property of the worksheetfunction class

Acting on common sense, I used Worksheetfunction.Trim to do the job. It worked with some short string (around 500 chars). However, as the string got larger (over 39000 chars), it kept returning the error '1004' - unable to get trim property of the worksheetfunction class

毫无疑问，我在工作表中使用长字符串执行了一些测试.我在一个单元格中输入了一个虚拟字符串，例如"aaaaaabbbbbbcccc ..."，然后在另一个单元格中输入了=TRIM(string).有用. 它如何在工作表中起作用，但在VBA中却不起作用.我有点困惑.

In doubt, I performed some tests with long string in a worksheet. I entered a dummy string like "aaaaaabbbbbbcccc..." in a cell and =TRIM(string) it in another cell. It works. How does it work in worksheet but not in VBA. I am kinda confused.

要完成这项工作，我做了自己的TRIM函数作为解决方法.但是我仍然想知道worksheetfunction.Trim发生了什么. Worksheetfunction.Trim的限制是多少?

To do the work, I made my own TRIM function as a workaround. But I still want to know what was happening with worksheetfunction.Trim. What is the limit of Worksheetfunction.Trim ?

感谢您的帮助. :)

这是我的代码:

我使用以下功能: get_address(wks as worksheet) as string:获取包含常量和公式形式的数据的所有范围的地址.

I use the following functions: get_address(wks as worksheet) as string : to get address of all ranges containing data in form of constant and formula.

EXNUM(TextIn as string, optional separator as string = " ") as string:从字符串中删除所有非数字字符

EXNUM(TextIn as string, optional separator as string = " ") as string : to remove all non-numeric character from a string

首先，我将使用get_address来获取范围地址，然后使用EXNUM来获取范围地址. 然后我将对EXNUM的结果运行worksheetfunction.trim

First I will get the range address with get_address then EXNUM the address. Then I will run worksheetfunction.trim on EXNUM's result

Function get_address(wks As Worksheet) As String

    '***Find the range***
    Dim rs1 As range, rs2 As range

    On Error Resume Next
    Set rs1 = wks.Cells.SpecialCells(xlCellTypeConstants)

        If Err.Number <> 0 Then
           Set rs1 = Nothing
        End If

    Set rs2 = wks.Cells.SpecialCells(xlCellTypeFormulas)

        If Err.Number <> 0 Then
            Set rs2 = Nothing
        End If

    '***Extract range address***
    Dim ad1 As String, ad2 As String
    Dim result As String

    ad1 = area_address(rs1)
    ad2 = area_address(rs2)

    result = ad1 & "," & ad2

    If Right(result, 1) = "," Then
        result = Left(result, Len(result) - 1)
    End If

    get_address = result
End Function



Function EXNUM(TextIn As String, _
                Optional separator As String = " ") As String

Dim x As Double
Dim result As String

    For x = 1 To Len(TextIn)
            If Not IsNumeric(Mid(TextIn, x, 1)) Then
                result = result + separator
            Else
                result = result + Mid(TextIn, x, 1)
            End If
    Next x

    If Len(result) >= 1 And Right(result, 1) = separator Then
        result = Left(result, Len(result) - 1)
    End If

EXNUM = result
End Function

'**********Supporting function only************

Public Function area_address(r As range) As String

    Dim x As Double
    Dim result As String

    For x = 1 To r.Areas.count

    result = result + r.Areas.Item(x).address(rowabsolute:=False, columnabsolute:=False) + ","
    Next x

    If Right(result, 1) = "," Then
        result = Left(result, Len(result) - 1)
    End If
    'Debug.Print r.Areas.count
    area_address = result
End Function

这是错误的屏幕快照和字符串的len

Here is the screen shot of the error and len of the string

更新: @brettdj:这是我正在做的.这是一个非常简单的想法.我想创建一个名为DetectSizeX的函数. 输入工作表或范围时，DetectSizeX将返回较小范围的地址，其中包含较大范围/工作表中的所有数据.

UPDATE: @brettdj: here is what I am working on. It is a fairly simple idea. I want to create a function called DetectSizeX. I input a worksheet or a range, the DetectSizeX will return address of a smaller range contain all the data in the larger range/worksheet.

例如:DetectSizeX(Activesheet) ==>返回"A3:T3568" 我的功能是这样的:

For instance: DetectSizeX(Activesheet) ==> return "A3:T3568" My function works like this:

第1步:使用以下方法检测包含所有数据的分段范围:

Step 1: detect the fragmented range contain all the data by using:

Cells.SpecialCells(xlCellTypeConstants)
Cells.SpecialCells(xlCellTypeConstants)

第2步:获取从上方获得的大范围内所有分段范围的地址.将所有地址合并为一个字符串.称为r_address.

Step 2: get address of all the fragmented range in the big range gotten from above. join all the address into one string. Call it r_address.

r_address看起来像是"A1，B33:C88，T6:Z90，K7:Z100 ..." 第3步:获取左上角和右下角的单元格地址

r_address looks like "A1, B33:C88, T6:Z90, K7:Z100..." Step 3: get the top-left and bot-right cells' address

r_address字符串中的最大数字代表最后一行. r_address字符串中的最小数字代表第一行.

The largest number in r_address string represents the last row. The smallest number in r_address string represents the first row.

也

r_address中的最大"列名(如A，B，AA，AZ)代表最后一列 r_address中的最小"列名代表第一列.

The "largest" col name (like A, B, AA, AZ) in r_address represent the last column The "smallest" col name in r_address represent the first column.

Concatenate(smallest col name, smallest number) 和 Concatenate(largest col name, largest number)

请给我两个单元格的地址，作为DetectSizeX的结果，我可以用它们来确定范围

give me the address of two cells which I can use to determine the range as the result of DetectSizeX

这是我对所有感兴趣的人的完整代码，它很长: 任何建议和改进都受到欢迎和赞赏:)

Here is my full code for anyone who is interested in, it is pretty long: Any suggestion and improvement is welcomed and appreciated :)

'====================================
'**********Detectsize V6*************
'====================================

Public Function DetectSizeX_v6(WorkSheetIn As Worksheet, Optional r_ad As String = vbNullString) As String
'**Note: if DetectSizeX_v5 return a string "0", it means an error, should skip that worksheet
    Dim address As String
    Dim top_left As String
    Dim bot_right As String

    Dim max_row As Double
    Dim min_num As Double
    Dim max_col As String
    Dim min_col As String

    If r_ad = vbNullString Then
        address = get_address(WorkSheetIn)
    Else
        address = get_address_range(WorkSheetIn, r_ad)
    End If

    If Len(address) > 0 Then
        max_row = get_row(address, True)
        min_num = get_row(address, False)

        max_col = get_col_name(address, True)
        min_col = get_col_name(address, False)

        top_left = min_col & min_num
        bot_right = max_col & max_row

        DetectSizeX_v6 = top_left & ":" & bot_right
    Else
        DetectSizeX_v6 = "0"
    End If
End Function

'*************GET_ADDRESS HERE*********************

Public Function get_address(wks As Worksheet) As String

    '***Find the range***
    Dim rs1 As range, rs2 As range

    On Error Resume Next
    Set rs1 = wks.Cells.SpecialCells(xlCellTypeConstants)

        If Err.Number <> 0 Then
           Set rs1 = Nothing
        End If

    Set rs2 = wks.Cells.SpecialCells(xlCellTypeFormulas)

        If Err.Number <> 0 Then
            Set rs2 = Nothing
        End If

    '***Extract range address***
    Dim ad1 As String, ad2 As String
    Dim result As String

    ad1 = area_address(rs1)
    ad2 = area_address(rs2)

    result = ad1 & "," & ad2

    If Right(result, 1) = "," Then
        result = Left(result, Len(result) - 1)
    End If

    get_address = result

End Function

Public Function area_address(r As range) As String

    Dim x As Double
    Dim result As String

    For x = 1 To r.Areas.count
        result = result + r.Areas.Item(x).address(rowabsolute:=False, columnabsolute:=False) + ","
    Next x

    If Right(result, 1) = "," Then
        result = Left(result, Len(result) - 1)
    End If
    area_address = result
End Function

Public Function get_address_range(wks As Worksheet, r_ad As String) As String

'***Find the range***
Dim rs1 As range, rs2 As range

On Error Resume Next
Set rs1 = wks.range(r_ad).SpecialCells(xlCellTypeConstants)

    If Err.Number <> 0 Then
       Set rs1 = Nothing
    End If

Set rs2 = wks.range(r_ad).SpecialCells(xlCellTypeFormulas)

    If Err.Number <> 0 Then
        Set rs2 = Nothing
    End If

'***Extract range address***
Dim ad1 As String, ad2 As String
Dim result As String

ad1 = rs1.address(rowabsolute:=False, columnabsolute:=False)
ad2 = rs2.address(rowabsolute:=False, columnabsolute:=False)

result = ad1 + "," + ad2

If Right(result, 1) = "," Then
    result = Left(result, Len(result) - 1)
End If

get_address_range = result

End Function

'******SUPPORTING FUNCTION*******
'*********For DetectSizeX_v6*****
Public Function get_col_name(ByVal address As String, max_min As Boolean)

'****Extract column name from address + cleaning address****
'address = "D2: D7 , G8, B2: B9 , F7: F9 , C2: C10 , E2: E13 , B13: D13"
'Note: if get_col_name return string "0", it means an error
address = EXTEXT(address)
address = Replace(address, ",", " ")
address = Replace(address, ":", " ")
address = EXNONBLANK(address)

'***Split address into individual string***
    Dim arr() As String
    arr = Split(address, " ")

'***Convert column names into index***
    Dim x As Double
    Dim arr_size As Double
    Dim arr_num() As Double

    arr_size = UBound(arr)
    ReDim arr_num(0 To arr_size)

    For x = 0 To arr_size
        arr_num(x) = col_num(arr(x))
    Next x

'***Extract the max and the min col name/char***
    Dim temp_num As Double
    Dim max_char As String
    Dim min_char As String

        '***Max:
        temp_num = Application.WorksheetFunction.Max(arr_num)
        For x = 0 To arr_size
            If arr_num(x) = temp_num Then
                Exit For
            End If
        Next x
        max_char = arr(x)

        '***Min:
        temp_num = Application.WorksheetFunction.Min(arr_num)
        For x = 0 To arr_size
            If arr_num(x) = temp_num Then
                Exit For
            End If
        Next x
        min_char = arr(x)

'***Return value***
If max_min Then
    get_col_name = max_char
Else
    get_col_name = min_char
End If

End Function

Public Function get_row(ByRef address As String, max_min As Boolean)

Dim x As Double
Dim max_ad As String, min_ad As String
Dim max_row As Double, min_row As Double

For x = Len(address) To 1 Step -1
    If Mid(address, x, 1) = "," Then
        max_ad = Right(address, Len(address) - x)
        Exit For
    End If
Next x

For x = 1 To Len(address)
    If Mid(address, x, 1) = "," Then
        min_ad = Left(address, x - 1)
        Exit For
    End If
Next x

max_ad = EXNONBLANK(EXNUM(max_ad))
min_ad = EXNONBLANK(EXNUM(min_ad))

'***get_max_min

Dim arr() As String
Dim arr_val() As Double
Dim arr_size As Double

arr = Split(max_ad + " " + min_ad, " ")
arr_size = UBound(arr, 1)
ReDim arr_val(0 To arr_size)

For x = 0 To UBound(arr, 1)
    arr_val(x) = Val(arr(x))
Next x

max_row = Application.WorksheetFunction.Max(arr_val)
min_row = Application.WorksheetFunction.Min(arr_val)

If max_min Then
    get_row = max_row
Else
    get_row = min_row
End If

End Function
Public Function EXTEXT(TextIn As String, _
                Optional separator As String = " ") As String

Dim x As Double 'for long text
Dim result As String

    For x = 1 To Len(TextIn)
            If IsNumeric(Mid(TextIn, x, 1)) Then
                result = result + separator
            Else
                result = result + Mid(TextIn, x, 1) + separator
            End If
    Next x

If Len(result) >= 1 And Right(result, 1) = separator Then
    result = Left(result, Len(result) - 1)
End If

EXTEXT = result
End Function
Public Function EXNUM(TextIn As String, _
                Optional separator As String = " ") As String

Dim x As Double
Dim result As String

    For x = 1 To Len(TextIn)
            If Not IsNumeric(Mid(TextIn, x, 1)) Then
                result = result + separator
            Else
                result = result + Mid(TextIn, x, 1)
            End If
    Next x

    If Len(result) >= 1 And Right(result, 1) = separator Then
        result = Left(result, Len(result) - 1)
    End If

EXNUM = result
End Function

'***Convert col_name to col_number
Public Function col_num(col_name As String)
    col_num = range(col_name & 1).Column
End Function
'***End Convert col_name to col_number


Function EXNONBLANK(str As String) As String
Do While InStr(str, "  ") > 0
    str = Replace$(str, "  ", " ")
Loop
EXNONBLANK = trim$(str)
End Function
'====================================
'**********End Detectsize V6*********
'====================================

推荐答案

WorksheetFunction受与工作表相同的约束限制.对于32767个字符的单元格中的字符串(如user3964075所述).

WorksheetFunction's are limited by the same constraints as a worksheet. For Strings in Cells that's 32767 characters (as commented by user3964075).

您最好的选择是滚动自己的Trim函数，类似这样

Your best option is to roll your own Trim function, something like this

Function MyTrim(s As String) As String
    Do While InStr(s, "  ") > 0
        s = Replace$(s, "  ", " ")
    Loop
    MyTrim = Trim$(s)
End Function

从性能上讲，这实际上比WorksheetFunction.Trim(在30,000个字符的字符串上测试)要快一些(10％)

Performance wise this is actually slightly faster (10%) than WorksheetFunction.Trim (tested on strings of 30,000 char)

这篇关于如何在VBA中修剪一个很长的字符串?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！