如何在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屋!