Excel VBA меняет высоту строки на основе значения поиска
У меня есть книга с двумя листами. Первый имеет 2 столбца данных. Второй – отформатированное расписание. Я хочу найти значения в первом столбце данных в расписании, затем:
Замените данные во втором столбце. Увеличьте высоту строки ячейки с новым значением на 5. Измените шрифт всех ячеек в расписании на Calibri.
Это то, что я до сих пор, но он не работает:
- Если #REF! находится в поле Error Box Macro
- EXCEL Найти ближайший номер почтового индекса, где состояния равны
- искать все строки и столбцы в листе1 для строки, копировать всю строку на лист2, если найдено
- Изменение значений в пределах диапазона, избегающего циклов, для скорости
- Как получить адрес ячейки от функции Найти в excel vba
Public Sub FindReplace() Dim AllCells As Range Dim myList As Range Dim myRange As Range Dim myHeight As Double Set AllCells = Sheets("Sheet 1").Cells AllCells.Font.Name = "Calibri" Set myList = Sheets("FindReplace").Range("A1:C200") Set myRange = Sheets("Sheet 1").Cells For Each cel In myList.Columns(1).Cells myRange.Select Selection.Find(What:=cel.Value, LookIn:=xlFormulas, LookAt:=xlWhole).Activate ActiveCell.RowHeight = myHeight myHeight = myHeight + 5 Selection.RowHeight = myHeight myRange.Replace cel.Value, cel.Offset(0, 2), LookAt:=xlWhole Next cel End Sub Пожалуйста помоги
- Excel - поиск и замена с использованием комбинированного (значения и форматирования) состояния
- Как найти адрес ячейки дубликатов с помощью VBA
- Найти Loop с внутренним SumIFS
- Как найти несколько значений, сохранить их, а затем управлять ими в VBA?
- Найти и скопировать код
- Excel: поиск и замена первого ряда и листа excel
- VBA: поиск текста в текстовой ячейке и копия
- vba искать значение в столбце из другой книги?
Попробуй это:
Option Explicit Public Sub FindReplace() Dim myList, myRange, CelA, celB As Range Set myRange = Sheets("T3").Cells myRange.Font.Name = "Calibri" Set myList = Sheets("T2").Range("A1:c200") For Each CelA In myList.Columns(1).Cells If CelA <> "" Then Set celB = myRange.Cells.Find(What:=CelA.Value, LookIn:=xlFormulas, LookAt:=xlWhole) If Not celB Is Nothing Then If celB.RowHeight < 410 Then celB.RowHeight = celB.RowHeight + 5 myRange.Replace CelA.Value, CelA.Offset(0, 2), LookAt:=xlWhole End If End If Next CelA End Sub
Что-то вроде этого может работать:
Option Explicit Public Sub FindReplace() Dim AllCells As Range Dim myList As Range Dim myRange As Range Dim myHeight As Double Dim cel 'not declared in your code, but its a good idea to do it Set AllCells = Sheets("T3").Cells AllCells.Font.Name = "Calibri" Set myList = Sheets("T2").Range("A1:C200") Set myRange = Sheets("T3").Cells For Each cel In myList.Columns(1).Cells myRange.Parent.Activate myRange.Select 'Selection.Find(What:=cel.Value, LookIn:=xlFormulas, LookAt:=xlWhole).Activate myHeight = myHeight + 5 If myHeight < 410 Then 'Selection.RowHeight = myHeight ActiveCell.RowHeight = myHeight End If myRange.Replace cel.Value, cel.Offset(0, 2), LookAt:=xlWhole Next cel End Sub
Что изменилось?
- Название листов.
- активный лист элемента
celактивируется с помощьюmyRange.Parent.Activate - Вводится условие для высоты 410.
- Вариант явно сверху
В общем, код не имеет высокого качества, потому что он использует Select и Activate и это противоречит наилучшим методам производительности и отладки.