Вставка пустой строки после строки в Excel

Я пытаюсь создать макрос в excel 2010, который находит каждую ячейку в листе со значением «Все клиенты». Каждый раз, когда это значение найдено, мне нужна пустая строка, вставленная под ним. Думал, что это будет довольно просто, но я обыскал многие форумы и пытался использовать какой-то пример кода, и я не могу заставить его работать правильно. Я совершенно новый, когда дело доходит до материала VBA. Думал, что я бы разместил здесь и проделал небольшое чтение по основам VBA.

Если у кого-то есть хорошие учебные ресурсы, отправьте их также.

Заранее спасибо!

EDIT: В моем OP я забыл упомянуть, что любая строка, содержащая значение «Все клиенты», в идеале должна быть выделена и выделена жирным шрифтом увеличенного размера.

Эти действия – это то, что использовала старая программа просмотра / форматирования Crystal Report, которая автоматически обрабатывалась при извлечении отчета. После того, как мы обновили программу, я узнал, что этот способ форматирования был удален с выпуском более новой версии программы, согласно технической поддержке производителя программного обеспечения. Если бы это было определено в примечаниях к выпуску, я бы не выполнил обновление. Независимо от того, как я оказался в этой макро-катастрофе.

Что-то вроде этого кода, содержащегося в моей статье, является эффективным и избегает циклирования

  1. Он смеет и увеличивает размер шрифта, где текст найден (во всей строке, как указывает Тим, вы должны указать, означает ли вы только ячейку)
  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 

Возможно, вам придется добавить обработку ошибок в код, поскольку вы получите сообщение об ошибке, если не найдено ни одной ячейки с указанным значением.

Предполагая, что это на первом листе («лист 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 
Interesting Posts

Убирать функцию excel

Сравните диапазоны, чтобы узнать, равны ли они

Время вывода с использованием xlswrite

Создайте отчет Excel из таблицы SAS.

VBA Macro в Excel для сохранения html-файлов из диапазона ячеек

«Невозможно получить свойство Slope класса WorksheetFunction» Ошибка

Добавить что-то во все строки, начиная с листа excel

Как создать поля в сводной таблице, которые возвращают пробел, если есть ошибка?

VBA, «Левые» разные строки динамически

Как импортировать всю таблицу таблиц Excel в таблицу на SQL Server

Можно ли скопировать строку (с данными, слияние, стиль) в Excel с помощью Epplus?

Excel имеет нечитаемый контент при открытии книги, сохраненной openpyxl

Как читать данные из файла XLS (Excel) в java или андроид

Автоматизируйте удаление строк и замените их нижними строками в Excel Vba

Excel Вставка изображений в ячейки – центр и установка перемещения и размера – ячейки меняются, и они не фиксируются

Давайте будем гением компьютера.