Excel VBA - 创建包含类别和行的新工作表

Question

目标：拥有一个宏，该宏在一张表中包含内容的行，由空行分隔，具体取决于其他表的值。以下是最终输出的样子：

现在的情况（手动）：我转到工作表 3，查看存在哪些类别，然后在带红色背景的工作表 1 上手动添加它们。然后，我转到工作表 2，查看每个类别存在多少子项，然后在工作表 1 中手动添加那么多行。

第 2 页的图片：

第 3 页的图片（类别）

宏的情况：我运行一个宏，然后根据表 3 创建类别，并根据表 2 中的项目数在这些类别之间创建空行。

到目前为止，这是我的代码：

Sub AddingCategories()
'
' AddingCategories Macro
'

' here we copy the categories from the Categories sheet
    Sheets("Categories").Select                         'we select the sheet where the categories are
    Range("A1").Select                                  'we select the first cell with content
    Range(Selection, Selection.End(xlDown)).Select      'we can select all categories with content
    Application.CutCopyMode = False
    Selection.Copy                                      'we copy the content
    Sheets("Timeschedule2").Select                      'we go to the destination sheet
    Range("B11").Select                                 'We select the first row where we want content
    ActiveSheet.Paste

'Here we format them to red

    Range("A11:B25").Select                             'since we just copied content, we need to have the cells with the formatting we want (in this case red)
    Application.CutCopyMode = False
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
'Here we delete all rows without content
    Range("B11:B30").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    ActiveWindow.SmallScroll Down:=-6
    Selection.EntireRow.Delete

'Here we add the rows. Since we want to specify a number of rows to add, we first calculate this value using a countif function
'this will tell us how many rows we need to add and we have it in Categories!C1. To add that many rows, we use a loop


For i = 1 To Worksheets("Categories").Range("C1")

Worksheets("Timeschedule2").Select
Rows("12:12").Select
Selection.Insert
With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

Next i
End Sub

使用这段代码，我非常自豪地创建了类别并设法为第一个类别创建了行数。 我现在的问题是我不知道如何创建将自动为所有类别执行此操作的循环（要执行第一个，我指定将它们添加到第 12:12 行；但我无法提前知道他们应该在哪里添加下一个新行，也不是循环多少次，因为类别的数量会因项目而异） 我一直在使用 Do until IsEmpty、Do While、For 等进行搜索，但我无法弄清楚。

你会怎么做呢？如何改进现有代码？

我知道我的代码可能很不优雅，对此深表歉意！ 我主要对学习如何编程 VBA 感兴趣，而不是让这个特定的宏工作，所以如果你能像我是一个 5 岁的非程序员一样向我解释，我将不胜感激。

Answer 1

我解决了！

我没有在中间添加列，而是在粘贴新类别之前向下滚动所需的空格数。让我知道我是否可以进一步改进代码

Sub NoDelete()
'This is done to make navigating the macro easier and avoid errors
Set cate = ActiveWorkbook.Sheets("Categories")
Set times = ActiveWorkbook.Sheets("Timeschedule2")

'Instead of using Select (which increases errors) we use these variables to use the content of the cell we need
Dim rng As Range
Dim rng2 As Range
Dim rng3 As Range


'These counters are used for the loops to know how many rows we need
Dim RowCounter As Integer
    RowCounter = cate.Range("A1", cate.Range("A1").End(xlDown)).Rows.Count

Dim CateCount As Integer
CateCount = 0

Dim CateCount2 As Integer
CateCount2 = 0

Dim CateCount3 As Integer
CateCount3 = 0

'This is the loop which will repeat itself for as many times are there are categories in the categories sheet
For i = 1 To RowCounter
 'The offset is used to copy the next category and not the first each time, the counter will make sure it moves the appropriate amount of positions
    Set rng = cate.Range("A1").Offset(CateCount, 0)
    With rng
    rng.Copy
    End With

'for this one we tell where it should paste the value. For every new loop it needs to move more cells downward, which is why we use the CateCount 3
Set rng2 = times.Range("B11").Offset(CateCount2, 0)
With rng2
rng2.PasteSpecial
End With

'This looks complicated but it is only to format the backgrounf red
Set rng3 = rng2.EntireRow

With rng3.Interior
.Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 255
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
With rng3.Font
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
    .Name = "Arial"
    .Size = 12
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
    .Bold = True

End With

'The CateCount3 will count how many rows we need to add by counting how many times the category we are dealing with now
'defined by rng there is in the action sheet and then adding 1 one

CateCount3 = Application.CountIf(Worksheets("All actions Sheet").Range("C:C"), rng) + 1
'We need to add one unit to the counter so that for the next loop it will start one category below
CateCount = CateCount + 1
'The CateCount2 is used to add the right number of rows for the next loop
CateCount2 = CateCount2 + CateCount3
CateCount3 = 0


Next i  

End Sub