如何在excel中基于列排序插入单元格

时间:2016-06-16 02:14:47

标签: excel vba excel-vba

如何根据excel中的已排序列在特定位置插入具有值的新单元格?

例如,如果我在列中有这个已排序的数据。

abc
abcd
abcde
abcdefg
abcdefgh

我想插入一个值为abcdef的新单元格。

结果应该是。

abc
abcd
abcde
"abcdef"
abcdefg
abcdefgh

如何使用VBA实现这一目标?

4 个答案:

答案 0 :(得分:1)

我也相信在原始范围结束时插入新值并再次对其进行排序

这里是我的代码

Sub InsertSorted(rng As Range, newVal As String)
    With rng.EntireColumn
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1).value = newVal
        .Sort key1:=.Cells(1, 1), order1:=xlAscending
    End With
End Sub

将被利用如下

Sub main()
    InsertSorted ActiveSheet.Range("A1"), "abcdef" ' would also work with "Range("A:A")"
End Sub

答案 1 :(得分:0)

我只想在最后添加新值,然后使用列:

Sub InsertSorted()
    NewCellValue = "abcdef"
    LastRow = Worksheets("Sheet1").Cells(Range("A:A").Rows.Count, "A").End(xlUp).Row
    Worksheets("Sheet1").Cells(LastRow + 1, 1) = NewCellValue
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A:A")
        .Apply
    End With
End Sub

还有其他方法可以解决这个问题,但我认为这可能是最简单的。如果这在您的情况下不起作用,请告诉我。还有其他选择。

答案 2 :(得分:0)

我认为最简单的方法是将新的字符串值添加到第一个空行,然后对列进行排序。以下模块将执行此操作,insertValue变量指定要添加的文本。

Sub Sort()
    Dim insertValue As String
    insertValue = "ab"
    Worksheets("Sheet1").Activate
    Set currentCell = Range("A1")
    Do While Not IsEmpty(currentCell)
      Set currentCell = currentCell.Offset(1, 0)
    Loop
    Range(currentCell.Address).Value = insertValue
    Range("A1").Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlNo
End Sub

答案 3 :(得分:0)

下面将数据加载到数组中,确定要插入的位置,然后添加值并粘贴结果。没有行插入,但是一旦有了索引,就可以调整代码。 只是在几个案例中对此进行了测试,并且可以根据您的需求进行进一步定制

Option Base 1
Sub insertString()

    Dim rgRange As Range
    strToInsert = Cells(1, 2).Value
    Set rgRange = Range(Cells(1, 1), Cells(1, 1).End(xlDown))
    m = rgRange.Rows.Count

    Dim arArray() As String
    ReDim arArray(m)

'load data
    For i = 1 To m
        arArray(i) = rgRange(i, 1).Value
    Next i

'determine where add your string
    k = m + 1
    For i = 1 To m
        If strToInsert < arArray(i) Then
            k = i
            Exit For
        End If
    Next i


'shift all upper values +1
    m = m + 1
    ReDim Preserve arArray(m)
    g = k + 1
    For i = m To g Step -1
        arArray(i) = arArray(i - 1)
    Next i

'insert your string
    arArray(k) = strToInsert

'paste results overwriting previous range
    Set rgdest = Range(rgRange(1, 1), rgRange(1, 1).End(xlDown).Offset(1, 0))
    For i = 1 To rgdest.Rows.Count
        rgdest(i, 1).Value = arArray(i)
    Next i



End Sub