在Excel中的string之后插入一个空行

我正在尝试在Excel 2010中创build一个macros,以查找表单中的所有单元格,其值为“所有客户”。 每当发现这个值,我需要在它下面插入一个空行。 认为这将是非常简单的,但我已经search了很多论坛,并试图使用一些示例代码,我不能得到它正常工作。 当谈到VBA的东西时,我是一个完整的新手。 以为我会在这里发布,去做一些基本的VBA轻读。

如果有人有任何良好的培训资源,请将其发布。

提前致谢!

编辑:在我的OP中,我忽略了提到,任何包含“所有客户”值的行将理想地被突出显示,并以粗体显示,增加字体大小。

这些操作是旧的Crystal Report查看/格式化程序在拉取报表时用于自动处理的。 根据软件制造商的技术支持,在升级程序之后,我了解到这种types的格式化function已经随着新版本程序的发布而被删除。 如果在发行说明中对此进行了定义,我将不会执行升级。 无论如何,这就是我发现自己在这场macros大的灾难。

像这样的代码从我这里的一篇文章中得到的东西是有效的,并避免循环

  1. 它加粗和增加了文本的字体大小(在整行中,正如Tim指出的那样,你应该指定是否仅仅是单元格的意思)
  2. 它在比赛下面增加一个空白的行

Option Explicit Const strText As String = "All Customers" Sub ColSearch_DelRows() Dim rng1 As Range Dim rng2 As Range Dim rng3 As Range Dim cel1 As Range Dim cel2 As Range Dim strFirstAddress As String Dim lAppCalc As Long Dim bParseString As Boolean 'Get working range from user On Error Resume Next Set rng1 = Application.InputBox("Please select range to search for " & strText, "User range selection", ActiveSheet.UsedRange.Address(0, 0), , , , , 8) On Error GoTo 0 If rng1 Is Nothing Then Exit Sub 'Further processing of matches bParseString = True With Application lAppCalc = .Calculation .ScreenUpdating = False .Calculation = xlCalculationManual End With 'a) match string to entire cell, case insensitive 'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , False) 'b) match string to entire cell, case sensitive 'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , True) 'c)match string to part of cell, case insensititive Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , False) 'd)match string to part of cell, case sensititive ' Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , True) 'A range variable - rng2 - is used to store the range of cells that contain the string being searched for If Not cel1 Is Nothing Then Set rng2 = cel1 strFirstAddress = cel1.Address Do Set cel1 = rng1.FindNext(cel1) Set rng2 = Union(rng2.EntireRow, cel1) Loop While strFirstAddress <> cel1.Address End If 'Further processing of found range if required If bParseString Then If Not rng2 Is Nothing Then With rng2 .Font.Bold = True .Font.Size = 20 .Offset(1, 0).EntireRow.Insert End With End If End If With Application .ScreenUpdating = True .Calculation = lAppCalc End With End Sub 
 Public Sub InsertRowAfterCellFound() Dim foundRange As Range Set foundRange = Cells.Find(What:="yourStringOrVariant", After:=ActiveCell) 'Find the range with the occurance of the required variant Rows(foundRange.Row + 1 & ":" & foundRange.Row + 1).Insert 'Insert a new row below the row of the foundRange row foundRange.Activate 'Set the found range to be the ActiveCell, this is a quick and easy way of ensuring you aren't repeating find from the top End Sub 

您可能需要将error handling添加到代码中,因为如果找不到具有指定值的单元格,将会出现错误。

假设这是在第一张(“表1”),这是一个缓慢的答案:

 Sub InsertRowsBelowAllCustomers() 'Set your worksheet to a variable Dim sheetOne as Worksheet Set sheetOne = Worksheets("Sheet1") 'Find the total number of used rows and columns in the sheet (where "All Customers" could be) Dim totalRows, totalCols as Integer totalRows = sheetOne.UsedRange.Rows.Count totalCols = sheetOne.UsedRange.Columns.Count 'Loop through all used rows/columns and find your desired "All Customers" Dim row, col as Integer For row = 1 to totalRows For col = 1 to totalCols If sheetOne.Cells(row,col).Value = "All Customers" Then Range(sheetOne.Cells(row,col)).Select ActiveCell.Offset(1).EntireRow.Insert totalRows = totalRows + 1 'increment totalRows because you added a new row Exit For End If Next col Next row End Sub 

此函数从最后一行开始,返回到第一行,在A列中包含“所有客户”的每个单元之后插入一个空行。

 Sub InsertRowsBelowAllCustomers() Dim R As Integer For R = UsedRange.Rows.Count To 1 Step -1 If Cells(R, 1) = "All Customers" Then Rows(R + 1).Insert Next R End Sub 

错误是因为工作表没有在使用的范围内指定。 我稍微改变了我的文本在AJ列中的代码,并在单元格上方插入一行。

 Dim R As Integer For R = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 If Range("AJ" & R) = "Combo" Then Rows(R).Insert Next R