Question

此网站已有类似的内容：Copy and insert rows based off of values in a column

但是代码并没有把我带到我需要去的地方，而且我还没有能够调整它以使它适合我。

我的用户有一个包含4列A-D的工作表。 A列包含特定的合同编号，B列为空白，C列为零件编号，D列为合同编号的整个范围。我的用户想要计算整个范围合同号重复的次数，所以我在单元格E2中输入公式=countif($D$2:$D$100000,A2)并向下复制，给出了A列中特定合同出现在D列中的次数。此工作簿中的数字范围为1到11，但此方法将在其他工作簿中使用的数字可能会更高。

接下来我需要做的是在E列的所有值下面输入大于1的空白单元格，非常类似于前面提到的问题中的示例。然后我还需要在同一行中复制并完全插入复制的单元格以匹配A列中的同一行。示例：单元格E21的编号为5所以我需要仅移动E列中的单元格以便有4个空白单元格直接在它下面。在A列中，我需要复制单元格A21并将复制的单元格直接插入到下面的四行中。

尝试将空白单元格插入是一个试验，使用上一个问题中给出的代码。

    Dim sh As Worksheet
    Dim lo As ListObject
    Dim rColumn As Range
    Dim i As Long
    Dim rws As Long

    Set sh = ActiveSheet
    Set lo = sh.ListObjects("Count")

    Set rColumn = lo.ListColumns("Count").DataBodyRange
    vTable = rColumn.Value

    For i = rColumn.Rows.Count To 1 Step -1
        If rColumn.Cells(i, 1) > 1 Then
            rws = rColumn.Cells(i, 1) - 1
            With rColumn.Rows(i)
                .Offset(1, 0).Resize(rws, 1).Cells.Insert
                .EntireRow.Copy .Offset(1, 0).Resize(rws, 1).Cells
                .Offset(1, 0).Resize(rws, 1).EntireRow.Font.Strikethrough = True
            End With
        End If
    Next

我会非常感激任何帮助，因为我和这个怪物打了一个星期。

Answer 1

虽然确实可以这样做，但考虑将所有合同编号列表从D列移动到另一张表可能是个好主意。即使循环一个范围并根据单元格值插入行非常简单 - 它也会在D和E列中创建漏洞。

这里的代码只是简单地添加行并按指定的方式复制值。

Sub Main()

'---Variables---
Dim source As Worksheet
Dim startRow As Integer
Dim num As Integer
Dim val As String
Dim i As Long


'---Customize---
Set source = ThisWorkbook.Sheets(1) 'The sheet with the data
startRow = 2 'The first row containing data


'---Logic---
i = startRow 'i acts as a row counter
Do While i <= source.Range("E" & source.Rows.Count).End(xlUp).Row
'looping until we hit the last row with a value in column E
    num = source.Range("E" & i).Value 'Get number of appearances
    val = source.Range("A" & i).Value 'Get the value
    If num > 1 Then 'Number of appearances > 1
        Do While num > 1 'Create rows
            source.Range("A" & i + 1).EntireRow.Insert 'Insert row
            source.Range("A" & i + 1) = val 'Set value
            num = num - 1
            i = i + 1 'Next row
        Loop
    End If
    i = i + 1 'Next row
Loop

End Sub

当然，您也可以在插入新行后删除D列中的孔并修改E列中的公式，使其保持可复制状态，并且不会计算复制的行。

通常，如果可以将单个行视为单个对象，则会使事情变得更容易，因为创建或删除行只会影响该单个对象。在这里，我们有一行代表特定合同和所有合同清单中的合同 - 这可能会在以后造成麻烦（或者它可能完全没问题！）

宏如果值> 1则在下面插入空白单元格，并从上面的单元格中复制/粘贴值

1 个答案: