CDbl()问题与类型错配

Question

我对VBA相当陌生，我的任务是编写一个脚本，但我遇到了一些问题。它应该做的是在单个单元格中使用分号间距的数据(数据包含括号内的名称和数字)，并找到具有最大数字的名称，然后将其分隔成不同的单元格。

要从字符串中取出数字，我使用由ozgrid：http://www.ozgrid.com/VBA/ExtractNum.htm开发的自定义函数ExtractNumber

我一直在

错误424

在试图调用该函数时，确切地在其最后一行：

ExtractNumber = CDbl(lNum)

就像另一个用户建议的那样，我尝试在这里切换变量类型：

ExtractNumber(rCell As String, 

但这一点也没有帮助。我还尝试将CDbl()命令切换到任何其他C.()类型命令，并完全删除它。不走运。我觉得我好像撞到了一块巨大的砖墙，我的时间慢慢地用完了。我可以再一次寻求协助吗？这是我的完整代码：

Option Explicit

Sub Divide()

Dim txt As String
Dim i As Integer
Dim j As Integer
Dim Full As Variant
Dim a As Integer
Dim b As Integer
Dim stored() As Integer

txt = (CStr(ActiveCell.Value))
Full = Split(txt, ";")
a = UBound(Full)
b = a - 1

ReDim stored(b)

For i = 0 To a
    stored(i) = ExtractNumber((Full(i)))
Next i

Dim primary_index As Integer
Dim primary_no As Integer
Dim primary_name As String
primary_index = Application.Match(Application.Max(stored), stored, 0)
primary_no = stored(primary_index)
primary_name = Full(primary_index)
stored(primary_index) = 0

If UBound(stored) > 1 Then
    Dim secondary_index As Integer
    Dim secondary_no As Integer
    Dim secondary_name As String
    secondary_index = Application.Match(Application.Max(stored), stored, 0)
    secondary_no = stored(secondary_index)
    secondary_name = Full(secondary_index)
End If

For i = 0 To 6
    ActiveCell.EntireColumn.Offset(0, 1).Insert
Next i

If UBound(stored) > 2 Then
    Dim names() As String
    ReDim names(0 To a)
    For j = 0 To a
        If Not (j = primary_index Or j = secondary_index) Then
            names(j) = Full(j)
        End If
    Next j

    ActiveCell.Offset(0, 1).Value = primary_name
    ActiveCell.Offset(0, 2).Value = primary_no
    ActiveCell.Offset(0, 3).Value = secondary_name
    ActiveCell.Offset(0, 4).Value = secondary_no
    ActiveCell.Offset(0, 5).Value = names
    ActiveCell.Offset(0, 6).Value = (ActiveCell.Offset(0, 8).Value - primary_no             - secondary_no)

ElseIf UBound(stored) = 2 Then
    ActiveCell.Offset(0, 1).Value = primary_name
    ActiveCell.Offset(0, 2).Value = primary_no
    ActiveCell.Offset(0, 3).Value = secondary_name
    ActiveCell.Offset(0, 4).Value = secondary_no
End

Else
    ActiveCell.Offset(0, 1).Value = primary_name
    ActiveCell.Offset(0, 2).Value = primary_no
End

End If
End Sub

下面是我的数据示例：点击

单元格内容示例：A&W All American Food (1) ; American Pie Cafe (1) ; Arby's (53) ; Auntie Anne's (13) ; Auntie Anne's Hand-Rolled Soft Pretzels (1) ; Baskin Robbins (1) ; Beef-A-Roo (1) ; Big Steer Restaurant ; Bill Ellis BBQ (1) ; Breakfast/Soup Bar (116) ; Broadway Diner (4) ; Burger King (4) ; Chester's Chicken (2) ; Cinnabon (126) ; Country Market (1) ; Country Skillet (1) ; Cuban Cuisine Restaurant (1) ; Dairy Queen (23) ; Dan's Big Slice Pizza (1) ; Day Breaker's Cafe (1) ; Deli (17) ; Denny's (97) ; Dunkin' Donuts (6) ; Family Restaurant (1) ; Full Service (4) ; Golden Corral (2) ; Gooseberry Farms (1) ; GrandMa Max's (3) ; Hardee's (1) ; Hot Food and Pizza (44) ; Hot Stuff Pizza (3) ; Huddle House (1) ; IHOP Restaurant (1) ; J's Wok and Grill (1) ; Johnny Pastrami (1) ; Junie's Restaurant (1) ; KFC (3) ; Krispy Krunchy Chicken (1) ; Long John Silver's (1) ; Max's Highway Diner (1) ; McDonald's (39) ; Mexican Grill (1) ; Milestone Diner (3) ; Moe's Southwest Grill (6) ; Nathan's Famous (1) ; Noble Roman's Pizza (1) ; Penn 80 Grill (1) ; Pizza Hut (4) ; Pizza Shop (1) ; Q Eats (1) ; Quiznos (2) ; Sam Bass Steakhouse (1) ; Sbarro (1) ; Silver Skillet (1) ; Subway (231) ; Sunshine Cafe (1) ; Taco Bell (8) ; Taco Bell/KFC (1) ; Taco John's (1) ; Wendy's Old Fashioned Hamburgers (72)

Answer 1

也许像这样的东西能起作用。

这些值被拆分并放在临时工作表上进行排序。VBA中的数组排序可能更快。

这将前两行视为“初级”和“二级”品牌，即使它们的得分相同。其他所有的商店都是“其他商店”。

如果一个商店没有号码，那么它就给出了一个默认的数字0。

Sub Test()

    With ThisWorkbook.Worksheets("Arkusz1")
        Divide .Range("G1:G7")
    End With

End Sub


Sub Divide(TextRange As Range)

    Dim rCell As Range, rCell1 As Range
    Dim vSplit As Variant
    Dim wrkShtTmp As Worksheet
    Dim sOthers As String

    'The parent of the range is the worksheet.
    'The parent of the worksheet is the workbook - we want to add a worksheet to the workbook.
    Set wrkShtTmp = TextRange.Parent.Parent.Worksheets.Add

    For Each rCell In TextRange
        With wrkShtTmp
            vSplit = Split(rCell, ";")
            'Place the values on the temporary sheet.
            .Range("A1").Resize(UBound(vSplit)) = Application.Transpose(vSplit)

            'Remove number & brackets from name.
            '=TRIM(LEFT(A1,FIND("(",A1)-1))
            .Range("B1").Resize(UBound(vSplit)).FormulaR1C1 = _
                "=IFERROR(TRIM(LEFT(RC[-1],FIND(""("",RC[-1])-1)),RC[-1])"

            'Place numbers in column C.
            '=IFERROR(VALUE(SUBSTITUTE(MID(A1,FIND("(",A1)+1,LEN(A1)),")","")),0)
            .Range("C1").Resize(UBound(vSplit)).FormulaR1C1 = _
                "=IFERROR(VALUE(SUBSTITUTE(MID(RC[-2],FIND(""("",RC[-2])+1,LEN(RC[-2])),"")"","""")),0)"

            With .Sort
                .SortFields.Clear
                .SortFields.Add Key:=wrkShtTmp.Range("C1").Resize(UBound(vSplit)), _
                    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
                .SetRange wrkShtTmp.Range("A1").Resize(UBound(vSplit), 3)
                .Header = xlNo
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With

            'Place the top two in columns 22 & 23 (V & W)
            TextRange.Parent.Cells(rCell.Row, 22) = .Cells(1, 2)
            TextRange.Parent.Cells(rCell.Row, 23) = .Cells(2, 2)

            'Stick all the other stores together in a string.
            For Each rCell1 In .Range("B3").Resize(UBound(vSplit) - 2)
                sOthers = sOthers & rCell1 & ", "
            Next rCell1
            sOthers = Left(sOthers, Len(sOthers) - 2)
            'Place the other stores in column 24 (X)
            TextRange.Parent.Cells(rCell.Row, 24) = sOthers

            'Clear the temporary sheet and Other stores string.
            .Range("A1").Resize(UBound(vSplit), 3).ClearContents
            sOthers = ""

        End With
    Next rCell

    'Delete the temporary sheet.
    Application.DisplayAlerts = False
    wrkShtTmp.Delete
    Application.DisplayAlerts = True

End Sub

Answer 2

我猜问题是在您为浮点数使用的十进制分隔符中。你能这样做吗？

ExtractNumber(change_commas(Full(i)))

Public Function change_commas(ByVal myValue As Variant) As String
   Dim str_temp as String
   str_temp = CStr(myValue)
   change_commas = Replace(str_temp, ",", ".")
End Function