我希望我的代码遍历包含名称的单元格列表,然后将它们拆分为原始单元格旁边的单元格。我有一些基本的代码来做第一位,但是我很难让它在我的列表的其余部分循环,并且还将它输出到原始而不是A1当前的A1。我认为这是代码中“Cell”部分的一个问题,但我无法解决它。
Sub NameSplit()
Dim txt As String
Dim i As Integer
Dim FullName As Variant
Dim x As String, cell As Range
txt = ActiveCell.Value
FullName = Split(txt, " ")
For i = 0 To UBound(FullName)
Cells(1, i + 1).Value = FullName(i)
Next i
End Sub
答案 0 :(得分:5)
在名称值范围内使用For Each循环。在这种情况下,我只是假设他们在第一列,但你可以相应调整:
def f(v):
return len(v)
答案 1 :(得分:4)
确保您没有尝试Split一个空白单元格并立即写入所有值,而不是嵌套第二个For ... Next Statement。
Sub NameSplit()
Dim var As Variant
Dim rw As Long
With Worksheets("Sheet1") '<~~ you should know what worksheet you are on!!!!
'from row 2 to the last row in column A
For rw = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
'check to make the cell is not blank
If CBool(Len(.Cells(rw, "A").Value2)) Then
'split on a space (e.g. Chr(32))
var = Split(.Cells(rw, "A").Value2, Chr(32))
'resize the target and stuff the pieces in
.Cells(rw, "B").Resize(1, UBound(var) + 1) = var
End If
Next rw
End With
End Sub
如果您只想分割空间,是否考虑过Range.TextToColumns method?
Sub NameSplit2()
Dim var As Variant
Dim rw As Long
'disable overwrite warning
Application.DisplayAlerts = False
With Worksheets("Sheet1") '<~~ you should know what worksheet you are on!!!!
'from row 2 to the last row in column A
With .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
'Text-to-Columns with space delimiter
.TextToColumns Destination:=.Cells(1, 2), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, _
Tab:=False, Semicolon:=False, Comma:=False, Other:=False, _
Space:=True
End With
End With
Application.DisplayAlerts = True
End Sub
答案 2 :(得分:2)
当你一开始不确定有多少项时,循环是迭代项目的好方法。在这种情况下,一次执行期间的名称可能比下一次更多。
当你事先知道要循环的项目数量时,for循环很方便。在这种情况下,我们知道在循环开始时我们的名称数组中有多少个元素。
下面的代码从活动单元格开始向下运行,直到找到一个空单元格。
Sub SplitName()
' Splits names into columns, using space as a delimitor.
' Starts from the active cell.
Dim names As Variant ' Array. Holds names extracted from active cell.
Dim c As Integer ' Counter. Used to loop over returned names.
' Keeps going until the active cell is empty.
Do Until ActiveCell.Value = vbNullString
names = Split(ActiveCell.Value, Space(1))
' Write each found name part into a seperate column.
For c = LBound(names) To UBound(names)
' Extract element to an offset of active cell.
ActiveCell.Offset(0, c + 1).Value = names(c)
Next
ActiveCell.Offset(1, 0).Select ' Move to next row.
DoEvents ' Prevents Excel from appearing frozen when running over a large number of items.
Loop
End Sub
有几种方法可以改善此过程。
作为一般规则,当避免像ActiveCell这样的对象时,自动化会更加健壮。这是因为用户可以在代码执行时移动活动单元格。您可以重构此过程以接受源范围作为参数。然后,您可以构建另一个子计算源范围并将其传递给此子进行处理。这将提高SplitName
的可重用性。
您还可以查看Excel Text to Columns方法。这可能会使用更少的代码行产生所需的结果,这总是很好。
答案 3 :(得分:1)
如果可以的话,文本到列将是一个很好的方法。如果不是这里是使用数组和字典的方法。这样做的好处是所有单元都可以一次读取,然后在写回结果之前在内存中进行操作。
Sub SplitCells()
Dim i As Long
Dim temp() As Variant
Dim dict As Variant
' Create a dictionary
Set dict = CreateObject("scripting.dictionary")
' set temp array to values to loop through
With Sheet1
'Declare your range to loop through
temp = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
End With
' Split the values in the array and add to dictionary
For i = LBound(temp) To UBound(temp)
dict.Add i, Split(temp(i, 1), " ")
Next i
' Print dictionary results
With Sheet1.Cells(1, 2)
For Each Key In dict.keys
.Range(.Offset(Key - 1, 0), .Offset(Key - 1, UBound(dict.Item(Key)))) = dict.Item(Key)
Next Key
End With
End Sub