用于在Excel中自动添加行的宏

Question

I have an excel sheet with thousands of entries as shown in Table A below. Now, because of some requirement change, I want to add 3 additional 'TAGS' for each 'Name' as shown in Table B. For example, Name n1 will have tags t1, t2, t3 and t4 and corresponding to each TAG, there will be a separate comment. (A) One way to accomplish this would be to add three new rows to each column (it is okay to have 3 blank rows) (B) Another way would be to have 3 more worksheets in the same file corresponding to each tag. (C) A third way could be to have some filter for the Tag column...

Could someone please suggest a way to automate (A) above? (macro code would be appreciated) and it would be even better if someone can share code to do (C) .. or any elegant solution to the problem. Thank you!

TABLE A

Name id Tag     Comment
n1    1  t1    my t1 comment for id 1
n2    2  t1    my t1 comment for id 2
n3    3  t1    my t1 comment for id 3
n4    4  t1    my t1 comment for id 4
n5    5  t1    my t1 comment for id 5

---

TABLE B

Name  id  Tag         Comment
n1    1   t1        my t1 comment for id 1*
n1    1   t2        my t2 comment for id 1
n1    1   t3        my t3 comment for id 1
n1    1   t4        my t4 comment for id 1
n2    2   t1        my t1 comment for id 2
n3    3   t1        my t1 comment for id 3
n4    4   t1        my t1 comment for id 4
n5    5   t1        my t1 comment for id 5

Answer 1

Tested this code on your table and it should work

Sub NewRows()

Dim i As Long
Dim k As Long
Dim lastRow As Long
Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.Sheets("test")
lastRow = Range("B" & Rows.Count).End(xlUp).Row ' I assume that your unique ID's are in column B

For i = lastRow To 2 Step -1 '3 is the first row where you have data
    For k = 4 To 2 Step -1 'Amount of new lines you want to insert
          ws.Rows(i + 1).Insert shift:=xlShiftDown ' insert row
          ws.Range("A" & i + 1).Value = ws.Range("A" & i).Value 'copy value in column A from original entry
          ws.Range("b" & i + 1).Value = ws.Range("b" & i).Value 'copy value in column A from original entry
          ws.Range("C" & i + 1).Value = "T" & k 'update tag info for each new line
          ws.Range("d" & i + 1).Value = "this is " & ws.Range("C" & i + 1).Value & " comment for " & ws.Range("A" & i + 1).Value

    Next k
Next i


End Sub

I am not sure how you populate column D with comments but same principle applies.