如何工作表功能。在VBA中修改一个很长的字符串?

时间:2015-02-13 06:49:56

标签: string excel vba excel-vba

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

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

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

有疑问,我在工作表中使用长字符串执行了一些测试。我在一个单元格中输入了一个像“aaaaaabbbbbbcccc ...”这样的虚拟字符串,在另一个单元格中输入了=TRIM(string)。有用。 它在工作表中如何工作,但在VBA中却不起作用。我有点困惑。

为了完成这项工作,我将自己的TRIM功能作为一种解决方法。但我仍然想知道worksheetfunction.Trim发生了什么。 Worksheetfunction.Trim的限制是什么?

感谢任何帮助。 :)

这是我的代码:

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

EXNUM(TextIn as string, optional separator as string = " ") as 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

以下是错误和字符串len的屏幕截图

enter image description here

更新:  @brettdj:这就是我正在做的事情。这是一个相当简单的想法。我想创建一个名为DetectSizeX的函数。 我输入了工作表或范围,DetectSizeX将返回较小范围的地址,包含较大范围/工作表中的所有数据。

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

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

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

第2步:获取从上方获取的大范围内所有碎片范围的地址。将所有地址加入一个字符串。称之为r_address

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

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

另外

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

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

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

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

'====================================
'**********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*********
'====================================

1 个答案:

答案 0 :(得分:3)

WorksheetFunction受限于与工作表相同的约束。对于单元格中的字符串,为32767个字符(由user3964075评论)。

你最好的选择是推出你自己的修剪功能,就像这样

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字符串上测试)