如果值> 1，則在下面插入空白單元格的宏，並從上面的單元格復制/粘貼值

Question

該站點已經具有類似的功能： 根據列中的值復制和插入行

但是代碼並不能將我帶到需要去的地方，而且我也無法對其進行調整以使其對我有用。

我的用戶有一個包含4列AD的工作表。 A列包含特定的合同編號，B列為空白，C列包含部件號，D列包含合同編號的整個范圍。 我的用戶想計算整個范圍合同編號重復的次數，因此我在單元格E2中輸入了公式=countif($D$2:$D$100000,A2)並向下復制，從而給了我特定合同的次數此工作簿中的數字在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列中的公式，以使其保持可復制性，並且不為復制的行計算。

通常，如果可以將單個行視為單個對象，則使事情變得容易，因為創建或刪除一行僅會影響該單個對象。 在這里，我們有一行既代表特定合同，又代表所有合同列表中的合同-這可能最終會在以后引起麻煩（或者可能完全沒問題！）