在Excel中自动添加行的macros

我有一张Excel表格，其中有数千个条目，如下表A所示。 现在，由于某些需求的变化，我想为每个“名称”添加3个额外的“标签”，如表B所示。例如，名称n1将具有标签t1，t2，t3和t4，并对应于每个标签将是一个单独的评论。 （A）一种方法是为每列添加三个新行（可以有三个空行）（B）另一种方法是在同一个文件中再有三个工作表对应于每个标签。 （三）第三种方法可能是有一些filter的标签列…

有人可以请build议一种方法来自动化（A）以上？ （macros代码将不胜感激），如果有人可以共享代码做（C）或任何优雅的解决scheme，这将是更好的。 谢谢！

表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 

---

表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

testing这个代码在你的桌子上，它应该工作

 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 

我不知道如何填写D列的注释，但同样的原则适用。