1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 |
Sub SearchPN2() Dim i&, D As Object, PS& Dim t$, a, b, x&: x = 1 uskorenie With Sheets("Фактический Aff") t = .[Q2] 'критерий PS = .Cells(.Rows.Count, 1).End(xlUp).Row If PS > 1 Then .Cells(2, 1).Resize(PS - 1, 13).Clear End With With Sheets("Base") PS = .Cells(1, .Columns.Count).End(xlToLeft).Column a = .Range(.Cells(1, 1), .Cells(1, PS)).Value 'словарь позиций заголовков Set D = CreateObject("Scripting.Dictionary") D.CompareMode = 1 For i = 1 To UBound(a, 2) 'перебор всех столбцов D.Item(Trim(a(1, i))) = i Next With Sheets("Фактический Aff") a = .Range(.Cells(1, 1), .Cells(1, 13)).Value End With PS = .Cells(.Rows.Count, 1).End(xlUp).Row b = .Range(.Cells(1, "AX"), .Cells(PS, "AX")).Value 'критерий будем искать только в этом столбце! For i = 2 To PS If b(i, 1) = t Then x = x + 1 For ii = 1 To 13 'перебор 13 столбцов If D.exists(a(1, ii)) Then 'если заголовок нужный Sheets("Фактический Aff").Cells(x, ii).NumberFormat = .Cells(i, D.Item(a(1, ii))).NumberFormat Sheets("Фактический Aff").Cells(x, ii).Value = .Cells(i, D.Item(a(1, ii))).Value End If Next End If Next End With neuskorenie End Sub |
|
Поиск значения и копирование текста на 2 лист |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
выполните замену из предыдущего сообщения (P.S.)I have a large spreadsheet sent to me twice a month. I can record a couple of macros that help me delete the columns I don’t need and to sort the data, but I don’t know how to proceed from there. I need to find a value in Column F, select all Rows that contain that data, and then copy all of the Rows to a new sheet. If I try to record a macro while doing that via CTRL F, CTRL A, Close, CTRL-, etc. the resulting macro only selects the «Row Numbers» that contain the data, and then goes on from there. Since the actual number of the rows that contain the data will change twice a month it won’t work for me.
Below is what it generates:
Sub Macro910()
‘
‘ Macro910 Macro
‘
‘
Rows(«981:3588»).Select
Range(«F981»).Activate
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
Range(«A1»).Select
End Sub
Is there a way to get a macro to find the data in Column F, select all of the rows that contain the data, and copy all of the rows to a new sheet?
Any help would be greatly appreciated.
Поиск какого-либо значения в ячейках Excel довольно часто встречающаяся задача при программировании какого-либо макроса. Решить ее можно разными способами. Однако, в разных ситуациях использование того или иного способа может быть не оправданным. В данной статье я рассмотрю 2 наиболее распространенных способа.
Поиск перебором значений
Довольно простой в реализации способ. Например, найти в колонке «A» ячейку, содержащую «123» можно примерно так:
Sheets("Данные").Select
For y = 1 To Cells.SpecialCells(xlLastCell).Row
If Cells(y, 1) = "123" Then
Exit For
End If
Next y
MsgBox "Нашел в строке: " + CStr(y)
Минусами этого так сказать «классического» способа являются: медленная работа и громоздкость. А плюсом является его гибкость, т.к. таким способом можно реализовать сколь угодно сложные варианты поиска с различными вычислениями и т.п.
Поиск функцией Find
Гораздо быстрее обычного перебора и при этом довольно гибкий. В простейшем случае, чтобы найти в колонке A ячейку, содержащую «123» достаточно такого кода:
Sheets("Данные").Select
Set fcell = Columns("A:A").Find("123")
If Not fcell Is Nothing Then
MsgBox "Нашел в строке: " + CStr(fcell.Row)
End If
Вкратце опишу что делают строчки данного кода:
1-я строка: Выбираем в книге лист «Данные»;
2-я строка: Осуществляем поиск значения «123» в колонке «A», результат поиска будет в fcell;
3-я строка: Если удалось найти значение, то fcell будет содержать Range-объект, в противном случае — будет пустой, т.е. Nothing.
Полностью синтаксис оператора поиска выглядит так:
Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
What — Строка с текстом, который ищем или любой другой тип данных Excel
After — Ячейка, после которой начать поиск. Обратите внимание, что это должна быть именно единичная ячейка, а не диапазон. Поиск начинается после этой ячейки, а не с нее. Поиск в этой ячейке произойдет только когда весь диапазон будет просмотрен и поиск начнется с начала диапазона и до этой ячейки включительно.
LookIn — Тип искомых данных. Может принимать одно из значений: xlFormulas (формулы), xlValues (значения), или xlNotes (примечания).
LookAt — Одно из значений: xlWhole (полное совпадение) или xlPart (частичное совпадение).
SearchOrder — Одно из значений: xlByRows (просматривать по строкам) или xlByColumns (просматривать по столбцам)
SearchDirection — Одно из значений: xlNext (поиск вперед) или xlPrevious (поиск назад)
MatchCase — Одно из значений: True (поиск чувствительный к регистру) или False (поиск без учета регистра)
MatchByte — Применяется при использовании мультибайтных кодировок: True (найденный мультибайтный символ должен соответствовать только мультибайтному символу) или False (найденный мультибайтный символ может соответствовать однобайтному символу)
SearchFormat — Используется вместе с FindFormat. Сначала задается значение FindFormat (например, для поиска ячеек с курсивным шрифтом так: Application.FindFormat.Font.Italic = True), а потом при использовании метода Find указываем параметр SearchFormat = True. Если при поиске не нужно учитывать формат ячеек, то нужно указать SearchFormat = False.
Чтобы продолжить поиск, можно использовать FindNext (искать «далее») или FindPrevious (искать «назад»).
Примеры поиска функцией Find
Пример 1: Найти в диапазоне «A1:A50» все ячейки с текстом «asd» и поменять их все на «qwe»
With Worksheets(1).Range("A1:A50")
Set c = .Find("asd", LookIn:=xlValues)
Do While Not c Is Nothing
c.Value = "qwe"
Set c = .FindNext(c)
Loop
End With
Обратите внимание: Когда поиск достигнет конца диапазона, функция продолжит искать с начала диапазона. Таким образом, если значение найденной ячейки не менять, то приведенный выше пример зациклится в бесконечном цикле. Поэтому, чтобы этого избежать (зацикливания), можно сделать следующим образом:
Пример 2: Правильный поиск значения с использованием FindNext, не приводящий к зацикливанию.
With Worksheets(1).Range("A1:A50")
Set c = .Find("asd", lookin:=xlValues)
If Not c Is Nothing Then
firstResult = c.Address
Do
c.Font.Bold = True
Set c = .FindNext(c)
If c Is Nothing Then Exit Do
Loop While c.Address <> firstResult
End If
End With
В ниже следующем примере используется другой вариант продолжения поиска — с помощью той же функции Find с параметром After. Когда найдена очередная ячейка, следующий поиск будет осуществляться уже после нее. Однако, как и с FindNext, когда будет достигнут конец диапазона, Find продолжит поиск с его начала, поэтому, чтобы не произошло зацикливания, необходимо проверять совпадение с первым результатом поиска.
Пример 3: Продолжение поиска с использованием Find с параметром After.
With Worksheets(1).Range("A1:A50")
Set c = .Find("asd", lookin:=xlValues)
If Not c Is Nothing Then
firstResult = c.Address
Do
c.Font.Bold = True
Set c = .Find("asd", After:=c, lookin:=xlValues)
If c Is Nothing Then Exit Do
Loop While c.Address <> firstResult
End If
End With
Следующий пример демонстрирует применение SearchFormat для поиска по формату ячейки. Для указания формата необходимо задать свойство FindFormat.
Пример 4: Найти все ячейки с шрифтом «курсив» и поменять их формат на обычный (не «курсив»)
lLastRow = Cells.SpecialCells(xlLastCell).Row
lLastCol = Cells.SpecialCells(xlLastCell).Column
Application.FindFormat.Font.Italic = True
With Worksheets(1).Range(Cells(1, 1), Cells(lLastRow, lLastCol))
Set c = .Find("", SearchFormat:=True)
Do While Not c Is Nothing
c.Font.Italic = False
Set c = .Find("", After:=c, SearchFormat:=True)
Loop
End With
Примечание: В данном примере намеренно не используется FindNext для поиска следующей ячейки, т.к. он не учитывает формат (статья об этом: https://support.microsoft.com/ru-ru/kb/282151)
Коротко опишу алгоритм поиска Примера 4. Первые две строки определяют последнюю строку (lLastRow) на листе и последний столбец (lLastCol). 3-я строка задает формат поиска, в данном случае, будем искать ячейки с шрифтом Italic. 4-я строка определяет область ячеек с которой будет работать программа (с ячейки A1 и до последней строки и последнего столбца). 5-я строка осуществляет поиск с использованием SearchFormat. 6-я строка — цикл пока результат поиска не будет пустым. 7-я строка — меняем шрифт на обычный (не курсив), 8-я строка продолжаем поиск после найденной ячейки.
Хочу обратить внимание на то, что в этом примере я не стал использовать «защиту от зацикливания», как в Примерах 2 и 3, т.к. шрифт меняется и после «прохождения» по всем ячейкам, больше не останется ни одной ячейки с курсивом.
Свойство FindFormat можно задавать разными способами, например, так:
With Application.FindFormat.Font .Name = "Arial" .FontStyle = "Regular" .Size = 10 End With
Поиск последней заполненной ячейки с помощью Find
Следующий пример — применение функции Find для поиска последней ячейки с заполненными данными. Использованные в Примере 4 SpecialCells находит последнюю ячейку даже если она не содержит ничего, но отформатирована или в ней раньше были данные, но были удалены.
Пример 5: Найти последнюю колонку и столбец, заполненные данными
Set c = Worksheets(1).UsedRange.Find("*", SearchDirection:=xlPrevious)
If Not c Is Nothing Then
lLastRow = c.Row: lLastCol = c.Column
Else
lLastRow = 1: lLastCol = 1
End If
MsgBox "lLastRow=" & lLastRow & " lLastCol=" & lLastCol
В этом примере используется UsedRange, который так же как и SpecialCells возвращает все используемые ячейки, в т.ч. и те, что были использованы ранее, а сейчас пустые. Функция Find ищет ячейку с любым значением с конца диапазона.
Поиск по шаблону (маске)
При поиске можно так же использовать шаблоны, чтобы найти текст по маске, следующий пример это демонстрирует.
Пример 6: Выделить красным шрифтом ячейки, в которых текст начинается со слова из 4-х букв, первая и последняя буквы «т», при этом после этого слова может следовать любой текст.
With Worksheets(1).Cells
Set c = .Find("т??т*", LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstResult = c.Address
Do
c.Font.Color = RGB(255, 0, 0)
Set c = .FindNext(c)
If c Is Nothing Then Exit Do
Loop While c.Address <> firstResult
End If
End With
Для поиска функцией Find по маске (шаблону) можно применять символы:
* — для обозначения любого количества любых символов;
? — для обозначения одного любого символа;
~ — для обозначения символов *, ? и ~. (т.е. чтобы искать в тексте вопросительный знак, нужно написать ~?, чтобы искать именно звездочку (*), нужно написать ~* и наконец, чтобы найти в тексте тильду, необходимо написать ~~)
Поиск в скрытых строках и столбцах
Для поиска в скрытых ячейках нужно учитывать лишь один нюанс: поиск нужно осуществлять в формулах, а не в значениях, т.е. нужно использовать LookIn:=xlFormulas
Поиск даты с помощью Find
Если необходимо найти текущую дату или какую-то другую дату на листе Excel или в диапазоне с помощью Find, необходимо учитывать несколько нюансов:
- Тип данных Date в VBA представляется в виде #[месяц]/[день]/[год]#, соответственно, если необходимо найти фиксированную дату, например, 01 марта 2018 года, необходимо искать #3/1/2018#, а не «01.03.2018»
- В зависимости от формата ячеек, дата может выглядеть по-разному, поэтому, чтобы искать дату независимо от формата, поиск нужно делать не в значениях, а в формулах, т.е. использовать LookIn:=xlFormulas
Приведу несколько примеров поиска даты.
Пример 7: Найти текущую дату на листе независимо от формата отображения даты.
d = Date Set c = Cells.Find(d, LookIn:=xlFormulas, LookAt:=xlWhole) If Not c Is Nothing Then MsgBox "Нашел" Else MsgBox "Не нашел" End If
Пример 8: Найти 1 марта 2018 г.
d = #3/1/2018# Set c = Cells.Find(d, LookIn:=xlFormulas, LookAt:=xlWhole) If Not c Is Nothing Then MsgBox "Нашел" Else MsgBox "Не нашел" End If
Искать часть даты — сложнее. Например, чтобы найти все ячейки, где месяц «март», недостаточно искать «03» или «3». Не работает с датами так же и поиск по шаблону. Единственный вариант, который я нашел — это выбрать формат в котором месяц прописью для ячеек с датами и искать слово «март» в xlValues.
Тем не менее, можно найти, например, 1 марта независимо от года.
Пример 9: Найти 1 марта любого года.
d = #3/1/1900# Set c = Cells.Find(Format(d, "m/d/"), LookIn:=xlFormulas, LookAt:=xlPart) If Not c Is Nothing Then MsgBox "Нашел" Else MsgBox "Не нашел" End If
Копирование строк по условию из существующего набора данных в отдельную таблицу с помощью кода VBA Excel. Определение числа строк в исходной таблице.
Условие задачи
Есть исходная таблица (набор данных) со списком файлов, расположенных в двух папках. Необходимо строки таблицы, содержащие слово «Изображения», скопировать в новую таблицу, расположенную ниже исходного набора данных, через одну пустую строку. В результате должно получиться, как на изображении ниже:
Решение задачи
Код VBA Excel для копирования строк исходного набора данных по условию в отдельную таблицу:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
Sub KopirovaniyeStrok() Dim s As String, n As Long, m As Long, i As Long ‘Задаем условие поиска s = «Изображения» ‘Определяем номер последней строки исходной таблицы n = Range(«A2»).CurrentRegion.Rows.Count ‘Задаем номер первой строки новой таблицы m = n + 2 For i = 2 To n ‘Проверяем условие If Cells(i, 1) = s Then ‘Копируем строку, удовлетворяющую условию, в новую таблицу Cells(i, 1).Resize(1, 3).Copy Cells(m, 1) m = m + 1 End If Next End Sub |
При желании, можно добавить в эту процедуру еще одну переменную и автоматическое определение количества столбцов:
|
Dim c As Long c = Range(«A2»).CurrentRegion.Columns.Count |
Тогда выражение копирования примет следующий вид:
|
Cells(i, 1).Resize(1, c).Copy Cells(m, 1) |