插入一行n次

Question

我有一个包含10列的Excel文件。在第2、3、4列中，我有一个数字或短划线
如果这3个单元格的总和大于1，我需要将整行替换为n行，其中只有一列的值为1，但其他单元格保持不变。

Example
1 - -  #-> leave it as is
- 2 -  #-> replace that row with 2 rows : - 1 - ; - 1 -
2 - 1  #-> replace that row with 3 rows : 1 - - ; 1 - - ; - - 1;

我设法从下往上迭代，但我在内存中存储一行、操作它并在下面插入时遇到了问题。

Sub Test()      
Dim rng As Range
Dim count20, count40, count45, total, i As Integer

Set rng = Range("A3", Range("A3").End(xlDown))

For i = rng.Cells.count To 1 Step -1
count20 = 0
count40 = 0
count45 = 0
total = 0

count20 = Cells(rng.Item(i).Row, 10).Value
If count20 > 1 Then
total = total + count20
End If

count40 = Cells(rng.Item(i).Row, 11).Value
If count40 > 1 Then
total = total + count40
End If

count45 = Cells(rng.Item(i).Row, 12).Value
If count45 > 1 Then
total = total + count45
End If

If total <> 0 Then
MsgBox total
End If

Next i     
End Sub

Answer 1

编辑2

我已经根据您的最新评论提供了替代代码。它使用列J-L(10-12(作为要更改的数字单元格，使用列A-I(1-9(和M-AD(13-30(作为要保留文本的单元格。如前所述，假设表1从第3行开始，您可以根据需要进行更改。

Option Explicit
Sub testJtoL()
Dim LastRow As Long, i As Long, j As Long, c As Long, _
insertR As Long, TopRow As Long, BottomRow As Long
Dim b As Range
Dim ws As Worksheet
'*** This code is based your values being in Columns J-L (10-12) in sheet 1 ***
'Set sheet 1 as ws
Set ws = Sheet1
'Sheet1 column J is used here to get your last row
LastRow = ws.Cells(Rows.Count, 10).End(xlUp).Row
'*** This code is based your values starting in Row 3 ***
For c = LastRow To 3 Step -1
'Determine number of rows to insert based on sum of that row
insertR = Application.WorksheetFunction.Sum(Range(Cells(c, 10), Cells(c, 12))) - 1
If insertR = 0 Then GoTo skip

'STEP 1 insert the correct number of rows
With ws.Range(Cells(c + 1, 1), Cells(c + insertR, 30))
.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End With

'STEP 2 fill the values into the correct number of rows
insertR = insertR + 1
With ws.Range(Cells(c, 1), Cells(c, 30))
.Resize(insertR, 30).Value = .Value
End With

TopRow = c
If insertR = 0 And c = 3 Then
BottomRow = c
Else
BottomRow = c + insertR - 1
End If

'STEP 3 replace all numbers with 1 or "-"
'Replace numbers in column J
If ws.Range(Cells(c, 10), Cells(c, 10)).Value = "-" Then GoTo SkipA
i = ws.Range(Cells(c, 10), Cells(c, 10)).Value
j = 1

For Each b In ws.Range(Cells(TopRow, 10), Cells(BottomRow, 10))

If j <= i Then
b.Value = 1
b.Offset(0, 1).Value = "-"
b.Offset(0, 2).Value = "-"
Else
b.Value = "-"
End If
j = j + 1

Next b

SkipA:
'Replace numbers in column K
j = 1
For Each b In ws.Range(Cells(TopRow, 11), Cells(BottomRow, 11))
If b.Value = "-" Then GoTo SkipB
i = b.Value

If j <= i Then
b.Value = 1
b.Offset(0, 1).Value = "-"
Else
b.Value = "-"
End If
j = j + 1

SkipB:
Next b

'Replace numbers in column L
j = 1
For Each b In ws.Range(Cells(TopRow, 12), Cells(BottomRow, 12))
If b.Value = "-" Then GoTo SkipC
i = b.Value

If j <= i Then
b.Value = 1
Else
b.Value = "-"
End If
j = j + 1

SkipC:
Next b

skip:
Next c
End Sub