VBA從某個單詞中找到最后一行并復制它-有解無憂

我需要你的幫助...

我對宏真的很陌生。我想找到每個字母的最后一行，然后復制整行。我希望這是可能的。如果您在圖片中看到，A 的最后一行是第 Nr 行。8. 所以我想復制這一行，并將其插入到第 Nr.9 行。B 的最后一行是 Nr。15，所以我想復制它并插入第 nr 行。16，以此類推……

VBA從某個單詞中找到最后一行并復制它

uj5u.com熱心網友回復：

有很多方法是可能的。其中一種方法是FOR LOOP。

代碼：

Sub Add_dup()  
Set Rng = Application.InputBox("Select the range of cells", , , , , , , 8)

startrow = Rng.Row
startcol = Rng.Column
counter = 0

For i = startrow   1 To Rng.Rows.Count   startrow   counter   Rng.Rows.Count   startrow
    For j = startcol To Rng.Columns.Count   startcol - 1
       If Cells(i, j) <> Cells(i - 1, j) Then
            Cells(i, j).EntireRow.Insert
            Range(Cells(i - 1, j - 3), Cells(i - 1, j)).Copy Range(Cells(i, j - 3), Cells(i, j))
            
            'Uncomment the below line to get the newly added rows highlighted
            'Range(Cells(i, j - 3), Cells(i, j)).EntireRow.Interior.ColorIndex = 6
            i = i   1
            counter = counter   1
        End If
    Next j
Next i

lastrow = Rng.Rows.Count   startrow
Range(Cells(lastrow - 1, startcol - 3), Cells(lastrow - 1, startcol)).Copy Range(Cells(lastrow, startcol - 3), Cells(lastrow, startcol))

End Sub

用法：

由于我們詢問用戶的范圍，宏最初會提示您范圍
選擇從列開始到結尾的范圍（在您的情況下，您需要選擇D3to D31）
注意：如果您僅選擇 1 列（僅在您的情況下Kommentar_1），此宏將起作用

uj5u.com熱心網友回復：

以下是我的代碼。這是作業，但我相信有一種簡單的方法可以做到這一點。下一個問題：我有大約 80 個條目/類別，在這個示例代碼中只有 6 個類別（F1-F6）。所以如果我必須將代碼復制并粘貼到 F80，那真的會是一個很長的代碼，不是嗎？有沒有辦法簡化它？

代碼：

Sub Addrows()
Dim Fnd1 As Range, Finish
Count = Application.InputBox(Prompt:="How many row?", Default:=2)

F1:
Set Fnd1 = Range("O:O").Find("A", , , xlWhole, xlByRows, xlPrevious, False, , 
False)
Fnd1.EntireRow.Select
Fnd1.EntireRow.Copy
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(Count, 0)).EntireRow.Insert 
Shift:=xlDown
Application.CutCopyMode = False
F2:
Set Fnd1 = Range("O:O").Find("B", , , xlWhole, xlByRows, xlPrevious, False, , 
False)
Fnd1.EntireRow.Select
Fnd1.EntireRow.Copy
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(Count, 0)).EntireRow.Insert 
Shift:=xlDown
Application.CutCopyMode = False
F3:
Set Fnd1 = Range("O:O").Find("C", , , xlWhole, xlByRows, xlPrevious, False, , 
False)
Fnd1.EntireRow.Select
Fnd1.EntireRow.Copy
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(Count, 0)).EntireRow.Insert 
Shift:=xlDown
Application.CutCopyMode = False
F4:
Set Fnd1 = Range("O:O").Find("D", , , xlWhole, xlByRows, xlPrevious, False, , 
False)
Fnd1.EntireRow.Select
Fnd1.EntireRow.Copy
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(Count, 0)).EntireRow.Insert 
Shift:=xlDown
Application.CutCopyMode = False
F5:
Set Fnd1 = Range("O:O").Find("E", , , xlWhole, xlByRows, xlPrevious, False, , 
False)
Fnd1.EntireRow.Select
Fnd1.EntireRow.Copy
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(Count, 0)).EntireRow.Insert 
Shift:=xlDown
Application.CutCopyMode = False
F6:
Set Fnd1 = Range("O:O").Find("F", , , xlWhole, xlByRows, xlPrevious, False, , 
False)
Fnd1.EntireRow.Select
Fnd1.EntireRow.Copy
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(Count, 0)).EntireRow.Insert 
Shift:=xlDown
Application.CutCopyMode = False
MsgBox (Count & " was added")

End Sub

轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/411626.html

標籤：

上一篇：向表中添加多行資料

下一篇：公式化的細胞歸零