Question

我有一张Excel表格，我在A1到A10的范围内有不同的数字。我需要从单元格中获取值并在该单元格下添加许多行。

假设A1为3作为值，宏应该在A1下面添加2行。

我尝试使用“行”功能，但我找不到出路。

请帮忙。

Answer 1

这应该让你去。如果您需要任何进一步的帮助，请告诉我。

Sub CellsValue()
    Dim Colm As Integer
    Dim lastrow As Long, deflastrow As Long

    'Get the Position of the Required column which has the numbers that it has to shift towards
    Colm = WorksheetFunction.Match("Cells Value", Sheets("Sheet1").Rows(1), 0)

    'Get the lastrow of that column
    lastrow = ActiveSheet.Cells(Rows.Count, Colm).End(xlUp).Row
    deflastrow = Application.Sum(Range(Cells(1, Colm), Cells(lastrow, Colm)))

    For i = 2 To deflastrow + lastrow
        Range("A" & i + 1).Select
        InsertRow = Range("A" & i).Value

        If InsertRow > 0 Then
            InsertRow = InsertRow - 1
        End If

        If InsertRow = 0 Then
            Range("A" & i + 1).Select
        Else
            For j = 1 To InsertRow
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Next
        End If
    Next
End Sub

我做了改变。现在它会起作用。如果它适合你，请接受答案。

Answer 2

替代解决方案：

Sub tgr()

    Dim ws As Worksheet
    Dim i As Long

    Const sCol As String = "A"

    Set ws = ActiveWorkbook.ActiveSheet
    For i = ws.Cells(ws.Rows.Count, sCol).End(xlUp).Row - 1 To 1 Step -1
        With ws.Cells(i, sCol)
            If IsNumeric(.Value) Then
                If .Value - 1 > 0 Then .Offset(1).Resize(.Value - 1).EntireRow.Insert xlShiftDown
            End If
        End With
    Next i

End Sub

Answer 3

Dim i, max, num As Integer i = 1 max = 10 Do While i < max Range("A" & i).Select num = Selection.Value Dim x As Integer x = 0 Do While x < num i = i + 1 Range("A" & i).Select Selection.EntireRow.Insert max = max + 1 x = x + 1 Loop i = i + 1 Loop End Sub

获取单元格值并在下面添加多行

3 个答案: