目标:要有一个宏,其中一行中包含内容的行由空行分隔,具体取决于其他工作表的值。以下是最终输出的结果:
现在情况(手动):我转到表3,查看存在哪些类别,并在红色背景的工作表1上手动添加它们。然后,我转到第2页,查看每个类别中存在多少个子项,并在工作表1中手动添加多行。
图2:
图3的图片(类别)
Macro的情况:我运行一个宏,然后根据Sheet 3创建类别,并根据Sheet 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岁,我会感恩。
答案 0 :(得分: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