无法将拆分字符串的元素分配给变量

时间:2020-08-14 12:47:24

标签: arrays excel vba

我正在为一项我们要完成的常规任务构建一个名称拆分器。我正在尝试将其(一个人的全名)拆分为单个名称,然后将这些单个名称粘贴到工作表上的新单元格中。据我所知:

class2

我的数组正在填充,并且namSplit正在根据需要拆分名称。

出于某种原因,当我编译时,它表示我的Sub nameSorter() Dim nameArray As Variant Dim namA As String Dim namB As String Dim namC As String Dim namD As String Dim namSplit() As String Dim rowNum, spaceCount, namNum As Integer nameArray = Application.Transpose(Worksheets("MegaSorter").Range("A3:A50")) For Each nam In nameArray rowNum = nameArray(nam).row namSplit = Split(nam, " ") namNum = UBound(namSplit) If namNum = 4 Then namA = namSplit(0) namB = namSplit(1) namC = namSplit(2) namD = namSplit(3) Worksheets("MegaSorter").Range("B" & rowNum) = namA.Value Worksheets("MegaSorter").Range("C" & rowNum) = namB.Value Worksheets("MegaSorter").Range("D" & rowNum) = namC.Value Worksheets("MegaSorter").Range("E" & rowNum) = namD.Value ElseIf namNum = 3 Then namA = namSplit(0) namB = namSplit(1) namC = namSplit(2) Worksheets("MegaSorter").Range("B" & rowNum) = namA.Value Worksheets("MegaSorter").Range("C" & rowNum) = namB.Value Worksheets("MegaSorter").Range("D" & rowNum) = namC.Value ElseIf namNum = 2 Then namA = namSplit(0) namB = namSplit(1) Worksheets("MegaSorter").Range("B" & rowNum) = namA.Value Worksheets("MegaSorter").Range("C" & rowNum) = namB.Value ElseIf namNum = 1 Then namA = namSplit(0) Worksheets("MegaSorter").Range("B" & rowNum) = namA.Value Else End If Next nam 不是无效的标识符。查看文档,这意味着它什么也没有指向,但我正在定义这些变量,并在代码之前填充它们,所以看不到问题?

我确实只用3个'nam'变量来运行它,但我需要4个才能捕获具有4个名字的任何人(例如James Van Der Whal),因为我们在这类名字非常普遍的国家/地区设有代理商。 / p>

任何想法都将不胜感激:)

1 个答案:

答案 0 :(得分:0)

由于在SO上有许多类似的问题,我犹豫了一下。 另一方面,一个简单的问题可以证明一些 常见问题统一在一起,以及如何通过不同方法解决。

因此,我尝试通过几个步骤来修改您的代码 从接近OP的方法开始。

第一步

如以上评论所述,有必要分别声明每个变量类型或 VBA假定它为Variant。因此,rowNum中的spaceCountInteger不会被视为Dim rowNum, spaceCount, namNum As Integer

此外,使用Long会更安全,尤其是对于(范围)计数器而言;如今超过100万行的工作表可能会超过 整数限制(以32,767结尾)。

始终使用Option Explicit来强制变量声明。

如果您可以使用额外的变量namAnamC进行定义,则过于复杂 直接namSplit(n)

范围具有.Row属性,但是不能将其应用于数组

UBound(namSplit)返回数组的上限;如果它是从零开始的,则必须添加1以获取项目数。

始终尝试完全限定您的图纸参考。您可以在ThisWorkbook.Worksheets("MegaSorter")-With结构中使用当前VBA项目的工作表的代码(名称)代替End With,以缩短无休止的重复并避免输入错误。代码(名称)引用可能有助于其他用户手动重命名工作表。

Option Explicit             ' declaration head of your code module

Sub nameSorterCloseToOP()

Dim nameArray As Variant
Dim namA As String
Dim namB As String
Dim namC As String
Dim namD As String
Dim namSplit() As String
Dim rowNum As Long, spaceCount As Long, namNum As Long  ' declare each type separately
With Sheet1                             ' using the sheet's Code(Name)
    Dim rng As Range                    ' define data range
    Set rng = .Range("A3:A50")
    'assign data to "flat" 1-dim array
    nameArray = Application.Transpose(rng)
            
    Dim nam As Variant                  ' declare nam as Variant type
    rowNum = rng.Row                    ' define start row as top row of range
    For Each nam In nameArray
        namSplit = Split(nam, " ")
        'count right number of array items (usually you get a zero-based split array)
        namNum = UBound(namSplit) - LBound(namSplit) + 1 ' general rule for any array base
        If namNum = 4 Then
            namA = namSplit(0)
            namB = namSplit(1)
            namC = namSplit(2)
            namD = namSplit(3)
            .Range("B" & rowNum) = namA
            .Range("C" & rowNum) = namB
            .Range("D" & rowNum) = namC
            .Range("E" & rowNum) = namD
        ElseIf namNum = 3 Then
            namA = namSplit(0)
            namB = namSplit(1)
            namC = namSplit(2)
            .Range("B" & rowNum) = namA
            .Range("C" & rowNum) = namB
            .Range("D" & rowNum) = namC
        ElseIf namNum = 2 Then
            namA = namSplit(0)
            namB = namSplit(1)
            .Range("B" & rowNum) = namA
            .Range("C" & rowNum) = namB
        ElseIf namNum = 1 Then
            namA = namSplit(0)
            .Range("B" & rowNum) = namA
        Else
        End If
    
        'increment rowNum
         rowNum = rowNum + 1
    
    Next nam

End With
End Sub

代码精炼

为了避免namSplit数组中的令牌数量过多,有可能 将全名拆分为恰好 4个令牌,包括空令牌(请参见a部分) 通过在拆分之前将 blanks 加入每个项目。

也可以写数组 单个代码行将值设置为目标范围(请参见b.Range("B" & i + rowOffset).Resize(, maxItems) = namSplit

Sub nameSorterRefined()
Const maxItems As Long = 4
Dim nameArray  As Variant
Dim namSplit() As String
Dim Blanks     As String
Blanks = String(maxItems - 1, " ")      ' string with 4-1 blanks
With Sheet1             ' using the sheet's Code(Name)
    Dim rng As Range                    ' define data range
    Set rng = .Range("A3:A50")
    'assign data to "flat" 1-dim array
    nameArray = Application.Transpose(rng)
    
    Dim rowOffset As Long
    rowOffset = rng.Row - 1             ' start row as top row of range minus 1
    
    Dim i As Long, j As Long
    For i = 1 To UBound(nameArray)      ' 1-based, as transposed range data field
        'a) split nameArray into exactly 4 tokens, even empty ones
        namSplit = Split(nameArray(i) & Blanks, " ")
        'b) write items back to sheet
        .Range("B" & i + rowOffset).Resize(, maxItems) = namSplit
    Next i

End With
End Sub

仅阵列方法

或者可以将所有名称写到具有四列的预定义数据字段数组中(请参见ab部分) 并将它们写回一行(请参见c)。

Sub nameSorterArray()
    Const maxColumns As Long = 4
'a) assign data to variant 1-based 2-dim ("vertical") array
    Dim nameArray As Variant
    nameArray = Sheet1.Range("A3:A50")     ' get data referring to sheet's Code(Name)
    'make it a 4-column array (with data in its 1st column)
    '(note that you can only redimension the array's last! dimension)
    ReDim Preserve nameArray(1 To UBound(nameArray), 1 To maxColumns)
    
'b) write names to four columns array (overwriting full names in array's 1st column)
    Dim i As Long, j As Long, names
    For i = 1 To UBound(nameArray)          ' loop through full names
        names = Split(nameArray(i, 1), " ") ' split into names (gets 0-based 1-dim array)
        For j = 1 To UBound(names) + 1      ' add 1 to max 4 names to array columns
            nameArray(i, j) = names(j - 1)  ' names indices are zero-based, hence j minus 1
        Next j
    Next i

'c) write results to any target range
    Sheet1.Range("B3").Resize(UBound(nameArray), maxColumns) = nameArray
End Sub

祝你好运:-)