我正在为一项我们要完成的常规任务构建一个名称拆分器。我正在尝试将其(一个人的全名)拆分为单个名称,然后将这些单个名称粘贴到工作表上的新单元格中。据我所知:
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>
任何想法都将不胜感激:)
答案 0 :(得分:0)
由于在SO上有许多类似的问题,我犹豫了一下。 另一方面,一个简单的问题可以证明一些 常见问题统一在一起,以及如何通过不同方法解决。
因此,我尝试通过几个步骤来修改您的代码 从接近OP的方法开始。
第一步
如以上评论所述,有必要分别声明每个变量类型或
VBA假定它为Variant
。因此,rowNum
中的spaceCount
和Integer
不会被视为Dim rowNum, spaceCount, namNum As Integer
此外,使用Long
会更安全,尤其是对于(范围)计数器而言;如今超过100万行的工作表可能会超过
整数限制(以32,767结尾)。
始终使用Option Explicit
来强制变量声明。
如果您可以使用额外的变量namA
到namC
进行定义,则过于复杂
直接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
仅阵列方法
或者可以将所有名称写到具有四列的预定义数据字段数组中(请参见a
至b
部分)
并将它们写回一行(请参见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
祝你好运:-)