Question

我正在尝试编写一个VBA命令，以便拆分单元格内容并插入它包含的所有内容，一个单元格高于另一个单元格。

Sub SplitInsert()

Dim Cell As Variant
Dim Cell1 As Variant
Dim i As Integer

'Input column is on column A that I manually select'
'Then I press plau'

For Each Cell In Selection
    'I split the current selected cell into a variant tab'
    Cell1 = Split(Cell.Value)

    'Then I do a second loop to insert every Cell1 values'
    'one after the other in column B'
    For i = 0 To UBound(Cell1)
        'I don't know how to insert and shift down just a cell,'
        'and not a row or a column'
        Cells(2, 1).Insert '....' shift:=xlShiftDown
    Next
Next Cell
End Sub

输入：
- Desmond Hume-Jack Shepard
- Kate Austen
- John Locke-James Ford-Hugo Reyes

会变成

输出：
- Hugo Reyes
- 詹姆斯·福特
- John Locke
- Kate Austen
- Jack Shepard
- Desmond Hume

感谢您的帮助：）

Answer 1

Sub Macro2()
Dim Cell As Range
Dim Cell1 As Variant
Dim i As Integer

'Input column is on column A that I manually select'
'Then I press plau'

For Each Cell In Selection

    'I split the current selected cell into a variant tab'
    Cell1 = Split(Cell.Value, "-")

    'Then I do a second loop to insert every Cell1 values'
    'one after the other in column B'
    For i = 0 To UBound(Cell1)
        'I don't know how to insert and shift down just a cell,'
        'and not a row or a column'

        Cells(1, 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Cells(1, 2).Value = Cell1(i)
    Next i

Next Cell
End Sub

尝试并根据您的需求进行调整。我对你的代码进行了一些修改，但你的方法正确。

将单元格从Variant更改为Range
在Cell1 = Split(Cell.Value)行中你忘了第二个该方法的论点。我添加了Cell1 = Split(Cell.Value, "-")
最后使用Cells(1, 2).Value = Cell1(i)来调用数组值。

Answer 2

我并没有完全明白你的意思是什么？＃34;一个单元格高于另一个单元格＃34;。所以Foxfire和伯恩斯和伯恩斯可能会回答你的想法。我的代码会将结果插入B并插入一行以在输出中显示结构化视图。我还更改了代码中的一些内容，并尝试在代码后面发表评论，以便更好地理解它的作用。

Sub SplitInsert()
Dim Cell As Variant
Dim Cell1 As Variant
Dim i As Integer, j As Integer
Dim rng As Range
    Set rng = Selection                   ' get selection range
    j = Selection.Row                     ' get first selected row
    For Each Cell In rng                  ' perform for each on every cell in range
    Cell1 = Split(Cell.Value, "-")        ' added separator (I assume it's what you'd want to split?)

        For i = 0 To UBound(Cell1)
            If i > 0 Then Rows(j).Insert  ' only insert line if it's not the first value
            Cells(j, 2).Value = Cell1(i)  ' insert value in B
            j = j + 1                     ' increase row counter
        Next i
    Next Cell
End Sub

Answer 3

读取/写入工作表需要花费大量时间。小列表不是问题，但对于大型列表可能是个问题。

以下代码避免了

将源数据读入变量数组
拆分每个项目并按顺序输入集合对象
创建一个结果数组，并按相反的顺序从集合中填充
将结果数组写回工作表

Option Explicit
Sub SplitNames()
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes() As Variant
    Dim cNames As Collection
    Dim V As Variant
    Dim I As Long, J As Long

'Set results and source worksheets and ranges
Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet1")
    Set rRes = wsRes.Cells(1, 5)

'read source data into array
'you could use  vSrc=Selection  instead of determining the range as below
'the code below assumes the data is in column A starting at A1
With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

'split the names and read them into collection
Set cNames = New Collection
For I = 1 To UBound(vSrc, 1)
    V = Split(vSrc(I, 1), "-")
    For J = 0 To UBound(V)
        cNames.Add V(J)
    Next J
Next I

'create results array in reverse order
ReDim vRes(1 To cNames.Count, 1 To 1)
For I = 1 To cNames.Count
    vRes(cNames.Count + 1 - I, 1) = cNames(I)
Next I

'write the results
Set rRes = rRes.Resize(rowsize:=UBound(vRes, 1))
With rRes
    .EntireColumn.Clear
    .Value = vRes
    .EntireColumn.AutoFit
End With

End Sub

拆分单元格并将其内容一个单元格插入另一个单元格之上

3 个答案: