如何worksheetfunction.Trim在VBA很长的string?

我知道这个问题很奇怪 但是我所面临的并不是那么奇怪。

我有一些长string(大约1000字或更多 – 更新:对不起,不是1000,但大约39000,我的坏)。 他们包含我想修剪的空间。

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

有疑问,我在工作表中用长string进行了一些testing。 我在单元格中input了一个类似“aaaaaabbbbbbcccc …”的虚拟string,在另一个单元格中input了=TRIM(string) 。 有用。 它在工作表中如何工作,而不是在VBA中。 我有点困惑。

为了做这个工作,我做了我自己的TRIM函数作为解决方法。 但我仍然想知道worksheetfunction.Trim发生了什么。 什么是Worksheetfunction.Trimfunction的限制。

任何帮助表示赞赏。 🙂

这是我的代码:

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

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

首先我将得到范围地址与get_address然后EXNUM地址。 然后我将在EXNUM的结果上运行worksheetfunction.trim

 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 

这里是错误和string的len的屏幕截图

在这里输入图像描述

更新:@brettdj:这是我的工作。 这是一个相当简单的想法。 我想创build一个名为DetectSizeX的函数。 我input一个工作表或者一个范围,DetectSizeX会返回一个较小范围的地址,包含大范围/工作表中的所有数据。

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

步骤1 :检测碎片范围包含所有数据使用:

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

步骤2 :获得从上面得到的大范围内的所有分段范围的地址。 将所有的地址join到一个string中。 称之为r_address

r_address看起来像“A1,B33:C88,T6:Z90,K7:Z100 …” 第3步 :获取左上angular和bot右单元的地址

r_addressstring中的最大数字表示最后一行。 r_addressstring中的最小数字表示第一行。

r_address的“最大”col名称(如A,B,AA,AZ)表示最后一列r_address “最小”col名称代表第一列。

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

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

这里是我感兴趣的任何人的完整代码,这是很长的:任何build议和改进,欢迎和赞赏:)

 '==================================== '**********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个字符的单元格中的string(由user3964075注释)。

你最好的select是滚动你自己的修剪function,就像这样

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

性能明智这实际上比WorksheetFunction.Trim稍快(10%)(30,000字符的stringtesting)