采取单元格的值，并添加下面的许多行

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

让A1表示为3，macros应在A1下面加2行。

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

请帮忙。

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

备用解决scheme：

 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