Excel маска поиска файла

nurgaliev Пользователь Сообщений: 6 Регистрация: 08.02.2016

#1 08.02.2016 07:28:48 Всем здравствуйте, Необходимо чтобы файлы, находящиеся в одной папке (и подпапках) с рабочей книгой, находились по маске и копировались в отдельную директорию. Нижеприведенный код, копирует все файлы с подпапок (чьи имена взяты с отдельной колонки, SubFolder) без учета маски (взятой тоже c колонки, sMask) в папку с именем текстбокса (txt_banum) на рабочий стол пользователя. Также, создается выборка — таблица фильтруется по txt_banum.Value и копируется на отдельный файл. Как все же осуществить поиск по маске файлов во всех подпапках (без SubFolder)? Через FSO пробовал, не получилось =( Код Private Sub cmd_ok_Click() Dim sFilesPath As String, sNewPath As String, sMask As String Dim sFolder As String, sFiles As String, SubFolder As String, sDoc As String Dim sFile As String If txt_banum.Text = "" Or Len(txt_banum.Text) < 13 Then     MsgBox "НЕДОСТАТОЧНО СИМВОЛОВ!", vbCritical     'Selection.AutoFilter     Exit Sub End If lLastRow = Cells.SpecialCells(xlLastCell).Row Set iskk = Sheets(2).Range("A:A").Find(txt_banum.Text, lookat:=xlWhole) If Not iskk Is Nothing Then ActiveSheet.Range("$A$1:$D$" & lLastRow).AutoFilter Field:=1, Criteria1:=txt_banum.Text Range("$A$1:$D$" & lLastRow).Copy Sheets("CurrData").Cells.Delete Selection.Copy Sheets("CurrData").Range("A1") Sheets("CurrData").Columns("A:D").ColumnWidth = 20 Selection.AutoFilter Dim username1 Dim path As String username1 = Environ("USERNAME") path = "C:Users" & "" & username1 & "" & "Desktop" & "" & txt_banum.Value check = Dir(path & Application.PathSeparator, vbDirectory) With ThisWorkbook.Sheets("CurrData")         If Len(check) > 0 Then         MsgBox ("Папка " & txt_banum.Value & " уже существует")         Else         MkDir path         End If         NewPath = path & Application.PathSeparator & "Summary" & ".xlsx"         ThisWorkbook.Sheets("CurrData").Copy         ActiveWorkbook.SaveAs (NewPath)         ActiveWorkbook.Close End With ThisWorkbook.Activate sNewPath = path & Application.PathSeparator 'куда перемещать файлы Application.ScreenUpdating = False         kon = Sheets("CurrData").Range("I10000").End(xlUp).Row             'kona = Sheets("CurrData").Range("C10000").End(xlUp).Row         For i = 2 To kon             SubFolder = Sheets("CurrData").Cells(i, 9).Value             sDoc = Sheets("CurrData").Cells(i, 3).Value sFilesPath = ThisWorkbook.path & "" & SubFolder & Application.PathSeparator 'откуда перемещать файлы sMask = sDoc     sFolder = sFilesPath     sFiles = Dir(sFolder)          Do While sFiles <> ""         If InStr(sFiles, sMask) < 2 Then                  FileCopy sFolder & Application.PathSeparator & sFiles, sNewPath & Application.PathSeparator & sFiles         End If         sFiles = Dir     Loop     Application.ScreenUpdating = True Next txt_banum.Value = "" MsgBox "Пакет документов создан в директории " & path uf_main.Hide Selection.AutoFilter         Else: MsgBox "Номер не Найден!", vbCritical         Sheets("CurrData").Cells.Delete         Sheets(2).Select         lLastRow = Cells.SpecialCells(xlLastCell).Row         End If End Sub

Юрий Пользователь Сообщений: 741 Регистрация: 03.01.2013

Апострофф Пользователь Сообщений: 720 Регистрация: 06.04.2015

nurgaliev Пользователь Сообщений: 6 Регистрация: 08.02.2016	Да, я попутно запостил вопросы еще на несколько форумов. Быть может знаете как справиться с проблемой? Изменено: nurgaliev — 08.02.2016 11:07:12

Апострофф Пользователь Сообщений: 720 Регистрация: 06.04.2015

#5 08.02.2016 08:43:36 Знаем, вот только желания тратить время впустую нет. http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=rules Цитата 4. Не рекомендуется    4.1. Создавать одинаковые темы или сообщения в разных форумах (cross-posting). Публикуя один и тот же вопрос в разных форумах и на дружественных сайтах вы заставляете сразу нескольких людей параллельно думать над вашей задачей и обесцениваете усилия тех, кто даст ответ вторым-третьим и т.д.

nurgaliev Пользователь Сообщений: 6 Регистрация: 08.02.2016	Мне просто нужен код для поиска по маске и копирования его в папку.

Апострофф Пользователь Сообщений: 720 Регистрация: 06.04.2015	#7 08.02.2016 09:05:44 Поиск по маске — Код fn=dir(маска) while fn>"" msgbox fn fn=dir wend Копирование в папку — Код filecopy fn,папка + fn

Юрий М Модератор Сообщений: 60570 Регистрация: 14.09.2012 Контакты см. в профиле	#8 08.02.2016 10:27:42 Цитата nurgaliev написал: Мне просто нужен код А нам нужно, чтобы Вы информировали — где ещё разместили свои вопросы.

The_Prist Пользователь Сообщений: 14181 Регистрация: 15.09.2012 Профессиональная разработка приложений для MS Office

Вот еще кросс: http://www.excel-vba.ru/forum/index.php?topic=4291.0 там основное решение и дали, но автор изменил предложенное, т.к. оказалось, что еще какие-то ТекстБоксы участие принимают и т.д. Файл Excel со всеми этими элементами автор выкладывать не хочет, следовательно, помогать проблематично по голому коду. А каждый раз писать, что нужен файл уже надоело, тем более что автор не может взять свой файл с формой и выложить только нужное — там много какой-то секретной информации. Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

nurgaliev Пользователь Сообщений: 6 Регистрация: 08.02.2016

Прикрепляю файл примера моего макроса. при активации листа Example выплывает текстбокс, куда нужно ввести, к примеру, Watches Casio 1500. Далее — фильтрация и создание выборки на отдельном файле в папке Watches Casio 1500 на рабочем столе юзера. Проблема в том, что идет копирование всех файлов из папок, а не файлов по маске). Необходимо реализовать копирование лишь тех файлов, что соответствуют маске.

Апострофф Пользователь Сообщений: 720 Регистрация: 06.04.2015

#11 09.02.2016 11:14:49 Глядим в книгу, видим знамо что — Код sMask = "*" & sDoc & "*" '!!!     sFolder = sFilesPath               sFiles = Dir(sFolder & sMask)     Do While sFiles <> ""         'If InStr(sFiles, sMask) < 2 Then 'чушь какая-то!!!             FileCopy sFolder & Application.PathSeparator & sFiles, sNewPath & Application.PathSeparator & sFiles         'End If         sFiles = Dir     Loop

nurgaliev Пользователь Сообщений: 6 Регистрация: 08.02.2016	всем спасибо) все получилось) есть вопрос: как сделать поиск не в определенной папке, а в во всей директории, включая все подпапки? (не беря за основу название папки, где производить поиск)

Апострофф Пользователь Сообщений: 720 Регистрация: 06.04.2015

#13 11.02.2016 08:10:31 Цитата nurgaliev написал: как сделать поиск не в определенной папке, а в во всей директории Что за беспомощность такая? Сеть завалена примерами, да только всё не то — любимая отговорка. Код Option Compare Text Sub MAIN() Dim FSO As Object    Set FSO = CreateObject("Scripting.FileSystemObject")    Search FSO.GetFolder("D:"), "*ABC*.JPG" 'ИЩЕМ В УКАЗАННОЙ ПАПКЕ ФАЙЛ С ЗАДАННОЙ МАСКОЙ End Sub Sub Search(Fold As Object, MASK$) Dim SubFold As Object Dim File As Object    For Each File In Fold.Files      If File.Name Like MASK Then MsgBox File.Path    Next File    On Error GoTo ErrHandle    For Each SubFold In Fold.SubFolders      Debug.Print SubFold.Path      Search SubFold, MASK    Next SubFold    Exit Sub ErrHandle:    MsgBox "Нет допуска к папке """ & Fold.Path & """"    Err.Clear End Sub

nurgaliev Пользователь Сообщений: 6 Регистрация: 08.02.2016	#14 15.02.2016 14:04:51 И снова у меня проблема: Код Цитата Апостроффа я адаптировал, но при запуске макрос выводит сообщение «Нет Доступа..» и продолжает долго бесконечно грузится. Код ниже отображает копирование из нынешней директории найденного файла, в новую указанную мной. Быть может ошибка здесь? Код For Each File In Fold.Files      If File.Name Like MASK Then FSO.CopyFile File.Path, sNewPath & File.Name    Next File

Формулировка задачи:

Знаю, много тем было… почерпал информацию там, но остался один вопрос,
как мне сделать, что в имени файла не было типа файла — в моем случае txt.
например у меня в папке фаайлы 1.txt и 2.txt, то нужно вывести просто 1 и 2. Не знаю как сделать

Код к задаче: «Поиск файлов»

textual

ИмяФайлаБезРасширения = FSO.GetBaseName(ИмяФайла)

Взять файлы по маске, из директории, в которой открыт excel

jurafenix Дата: Пятница, 25.09.2015, 15:00 | Сообщение № 1 Группа: Пользователи Ранг: Участник Сообщений: 66 Репутация: 1 ± Замечаний: 0% ± Excel 2010 Добрый день! Имеется код, который по маске импортирует данные из txt файлов… Может подскажете, как заставить брать данные из файла не из строго заданной директории, а в случае перемещения файла из директории, где открыт excel. Код прилагаю. [vba] Код p_ = Dir(«O:_НиколаевскийГорбачевОтчетБисквит_ОСВ_рубли*_7777.txt») With ActiveSheet.QueryTables.Add(Connection:= _          «TEXT;O:_НиколаевскийГорбачевОтчетБисквит_ОСВ_рубли» & p_, _          Destination:=Range(«$A$1»))          .Name = Left(p_, Len(p_) — 4)          .FieldNames = True          .RowNumbers = False          .FillAdjacentFormulas = False          .PreserveFormatting = True          .RefreshOnFileOpen = False          .RefreshStyle = xlOverwriteCells          .SavePassword = False          .SaveData = True          .AdjustColumnWidth = True          .RefreshPeriod = 0          .TextFilePromptOnRefresh = False          .TextFilePlatform = 866          .TextFileStartRow = 1          .TextFileParseType = xlFixedWidth          .TextFileTextQualifier = xlTextQualifierDoubleQuote          .TextFileConsecutiveDelimiter = False          .TextFileTabDelimiter = True          .TextFileSemicolonDelimiter = False          .TextFileCommaDelimiter = False          .TextFileSpaceDelimiter = False          .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)          .TextFileFixedColumnWidths = Array(26, 5, 18, 20, 20, 20, 40, 11)          .TextFileTrailingMinusNumbers = True          .Refresh BackgroundQuery:=False      End With [/vba]   Ответить

Roman777 Дата: Пятница, 25.09.2015, 15:09 | Сообщение № 2 Группа: Проверенные Ранг: Ветеран Сообщений: 980 Репутация: 127 ± Замечаний: 0% ± Excel 2007, Excel 2013 jurafenix, по идее: [vba] Код p_ = Dir(ThisWorkbook.Path & «*_7777.txt») [/vba] Много чего не знаю!!!! Сообщение отредактировал Roman777 — Пятница, 25.09.2015, 15:09   Ответить

jurafenix Дата: Пятница, 25.09.2015, 15:31 | Сообщение № 3 Группа: Пользователи Ранг: Участник Сообщений: 66 Репутация: 1 ± Замечаний: 0% ± Excel 2010 Пробовал так, но директорию также нужно задать в слудубщей строчки. [vba] Код «TEXT;O:_НиколаевскийГорбачевОтчетБисквит_ОСВ_рубли» & p_, _ [/vba] А как туда пихнуть «текущая директория» непонятно(((   Ответить

Roman777 Дата: Пятница, 25.09.2015, 15:39 | Сообщение № 4 Группа: Проверенные Ранг: Ветеран Сообщений: 980 Репутация: 127 ± Замечаний: 0% ± Excel 2007, Excel 2013 jurafenix, а что мешает и сюда «TEXT;O:_НиколаевскийГорбачевОтчетБисквит_ОСВ_рубли» & p_, _ сделать так: [vba] Код «TEXT;» & ThisWorkbook.Path & «» & p_, _ [/vba] Много чего не знаю!!!!   Ответить

jurafenix Дата: Пятница, 25.09.2015, 15:45 | Сообщение № 5 Группа: Пользователи Ранг: Участник Сообщений: 66 Репутация: 1 ± Замечаний: 0% ± Excel 2010 Огромное спасибо!!! Тему можно закрывать… Видимо просто синтаксис неправильно применял…   Ответить

AndreTM Дата: Суббота, 26.09.2015, 04:22 | Сообщение № 6 Группа: Друзья Ранг: Старожил Сообщений: 1762 Репутация: 498 ± Замечаний: 0% ± 2003 & 2010 jurafenix, я так понял, что на этот вопрос вам уже был давно дан ответ, только ведь лень — она такая матушка… Skype: andre.tm.007 Donate: Qiwi: 9517375010   Ответить

jurafenix Дата: Понедельник, 28.09.2015, 13:15 | Сообщение № 7 Группа: Пользователи Ранг: Участник Сообщений: 66 Репутация: 1 ± Замечаний: 0% ± Excel 2010 Нет, как вы могли заметить, там я чётко прописывал путь. А в данной ситуации подразумевается перенос файла вместе с определенным каталогом данных… Так что не лень, а плохое знание мат. части   Ответить

Функция VBA для получения списка файлов из папки, с учётом выбранной глубины поиска в подпапках

Внимание: если требуется, чтобы поиск не зависел от регистра символов в маске файла (к примеру, обнаруживались не только файлы .TXT, но и .txt и .Txt), поставьте первой строкой в модуле эту директиву:
Option Compare Text

Пример в файле FilenamesCollection.xls выводит список файлов на чистый лист новой книги (формируя заголовки)

Пример в файле FilenamesCollectionEx.xls более функционален — он, помимо списка файлов из папки, отображает размер файла, и дату его создания, а также формирует в ячейках гиперссылки на найденные файлы. Вывод списка производится на лист запуска, параметры поиска файлов задаются в ячейках листа (см. скриншот)

ПРИМЕЧАНИЕ: Если вы выводите на лист список имен файлов картинок (изображений), то при помощи этой надстройки вы сможете вставить сами картинки в ячейки соседнего столбца (или в примечания к этим ячейкам)

Этот код позволяет осуществить поиск нужных файлов в выбранной папке (включая подпапки), и выводит полученный список файлов на лист книги Excel:

Ещё один пример использования:

Вот отсюда:
http://excelvba.ru/code/FilenamesCollection
там же качаются файлы примеров

Поиск или замена текста и чисел на листе

​Смотрите также​​ или строки; замена​ If myArr(j, i)​ вам нужно из​ из txt буду​Sanja​ переменную «iKey «​ Not delRng Is​ For i =​lion9​ в скобках ToAbsolute​ нужные участки, а​ менять. От этого​ найти слово или​все, щелкнув заголовок​ вкладке​ слова «год» и​Примечание:​ идет по всему​ Like iText(x) Then​ текстового файла загрузить​

​ удалять их вашим​: Одну строку упустил​ (с пробелом) потом​ Nothing Then Set​ 0 To UBound(iText)​: Спасибо огромное! Работает.​

1. ​ — константа из​​ если столбцов >26,​​ зависит формула для​​ фразу и заменить​​ столбца.​​Поиск​​ «город».​

   

2. ​ Мы стараемся как можно​ листу или даже​

   • ​ newArr(k, i) =​ 1.5 млн строк​​ макросом )​​Между 27 и​

   • ​ задатьНет.​ delRng = Union(delRng,​ Set iRange =​​ Буду думать, как​​ перечисления Excel.XlReferenceType: xlAbsolute​

3. ​ то не только​​ замены!​​ их.​Чтобы заменить текст или​; на вкладке «​Вопросительный знак заменяет один​​ оперативнее обеспечивать вас​​ книги. Как настроить​ myArr(j, i) k​ и при загрузке​

   ​Может кто то​ 28. Должно быть​Marat_Mamedov​ cl) Else Set​ Range(«A:B»).Find(What:=iText(i), LookIn:=xlFormulas, Lookat:=xlPart)​

   • ​ третьего контрагента добавить​ = 1, xlAbsRowRelColumn​ алфавит.​​Digitalizer​​На вкладке​ числа, введите знаки​Заменить​

   • ​ любой знак. Например,​ актуальными справочными материалами​ поиск и замену​​ = k +​​ их отфильтровать по​ сталкивался с подобной​ такСкрытый текст Sub​

     ​: Что то он​​ delRng = cl​ If Not iRange​ таким путём.​ = 2, xlRelRowAbsColumn​Manyasha​: Добрый день!​​Главная​​ для замены в​» доступны только​ если ввести​​ на вашем языке.​​ ТОЛЬКО в выделенном​

4. ​ 1 End If​​ одному столбцу по​​ задачей — «умный​ Макрос2() Dim iText,​ не работает.​

   • ​ End If flag​ Is Nothing Then​lion9​ = 3, xlRelative​​:​​В файле приведен​​нажмите кнопку​​ поле​​формулы​​г?д​

   • ​ Эта страница переведена​ столбце/строке? Например, в​ Next Next Next​​ небольшому списку ключей?​​ экспорт данных из​​ iKey, iTemp, i&,​​Нечего не происходит,​​ = False End​​ Do iRange.Delete Shift:=xlShiftUp​

   • ​: Спасибо огромное! Работает.​ = 4.​Digitalizer​​ перечень дат с​​Заменить​​Заменить на​​.​​, то будут найдены​​ автоматически, поэтому ее​​ OPEN OFFICE Эта​​ ‘для замены ‘на​

     ​Если так, то​​ txt» что бы​​ flag As Boolean​​ прикрепил файл в​​ If Next If​​ Set iRange =​​ Буду думать, как​​Digitalizer​, я правильно поняла,​​ заданной формулой. От​​.​​(или оставьте это​​Для поиска данных с​​ слова «гад», «гид»​​ текст может содержать​

   • ​ функция есть.​ месте’, замените D1​ вот вам вариант​​ перебрать текстовый файл​​ Dim myRng As​

   • ​ котором использовал код​ Not delRng Is​ Range(«A:B»).Find(What:=iText(i), _ LookIn:=xlFormulas,​​ третьего контрагента добавить​​: Gustav а как​​ что Вам просто​​ столбца к столбцу​

5. ​Кроме того, можно​ поле пустым, чтобы​ учетом регистра установите​ и «год».​​ неточности и грамматические​​Pelena​ на A1 Range(«D1»).Resize(UBound(newArr,​ на Power Query.​​ по условию (​​ Range, cl As​

   ​ от «» но​​ Nothing Then delRng.Delete​ Lookat:=xlPart) Loop Until​ таким путём.{/post}{/quote}​ быть если помимо​​ нужно формулы во​​ меняются только ссылки​ нажать клавиши CTRL+H.​ ничем не заменять​ флажок​Совет:​​ ошибки. Для нас​​: По-моему, во всех​​ 1), UBound(newArr, 2))​​Разархивируйте 2 файла​ в моем случаи​ Range, delRng As​

6. ​ после нажатия выполнить​ Shift:=xlShiftUp MsgBox «ненужные​

   • ​ iRange Is Nothing​=ИЛИ(ЕСЛИ(ЕОШ(НАЙТИ(«Турция»;E7));»Израиль»;»Турция»);ЕСЛИ(ЕОШ(НАЙТИ(«Египет»;E7));»Израиль»;»Египет»))​​ приведенных в формуле​​ второй строке привязать​​ на ячейки с​​В поле​

     ​ знаки), а затем​​Учитывать регистр​​ Звездочки, знак вопроса и​​ важно, чтобы эта​ версиях НАЙТИ/ЗАМЕНИТЬ работает​ = newArr MsgBox​ на С:test​ строка начинается и​ Range Dim dic​ макрос не чего​​ строки удалены!», 64,​​ End If Next​С вложением в​

   • ​ столбцов так же​ к первой, чтобы​ датами (например B1​Найти​​ нажмите кнопку​​.​ символы тильда (~)​ статья была вам​ по выделенному диапазону,​ «ненужные строки удалены!»,​​На листе Настройки​​ перечень условий )​​ As Object iText​​ не произошло (ячейки​

     ​ «конец» End Sub​​ i MsgBox «ненужные​​ функцию тоже не​​ заданы дополнительные параметры,​​ при протягивании вниз​​ и C1; следующая​

     ​введите искомые слово​Найти далее​Для поиска ячеек, содержащих​

7. ​ можно найти в​ полезна. Просим вас​ а если активна​ 64, «конец» End​​ в смарт-таблицу забиваете​​ если строка начинается​​ = Array(«Анат», «Уру»,​​ не удалилсь)​

Советы

• ​Jack Famous​ строки удалены!», 64,​ выходит Буду​ и если применить​ B1 не превращалось​ C1 и D1;​ или фразу.​или​ только символы, введенные​ данных листа перед​ уделить пару секунд​ только одна ячейка,​ Sub​​ ключи, по которым​​ на указанные условия​​ «Инокен») ‘список слов​​Ожидалось что удалятся​​: Sanja For i​​ «конец» End SubДанный​ благодарен тому, кто​ макрос то выдает​​ в B2?​​ и т.д.).​​В поле​​Найти все​

• ​ в поле​ их с тильда​ и сообщить, помогла​ то по всему​Marat_Mamedov​

support.office.com

Поиск и замена текста

​ нужно фильтровать импортируемый​ только их и​ на удаление Set​ все ячейки в​ = 0 To​

1. ​ макрос удаляет все​​ подскажет — де​​#ЗНАЧ!​​Если да, то​​Как можно добавить​
   ​Заменить на​.​

   

2. ​Найти​​ в поле​​ ли она вам,​ листу​

3. ​: Проста супеер !​​ список. На листе​​ забрать из текстовго​

4. ​ dic = CreateObject(«Scripting.Dictionary»)​​ диапазоне A:B которые​​ UBound(iText) iTemp =​ ячейки в диапазоне​ я ошибаюсь?​

5. ​Пример:​​ так попробуйте:​​ массово знак ‘$’​введите новый текст.​Примечание:​, установите флажок​​Найти​​ с помощью кнопок​

​Гиперссыльный​​ Спасибо всем огромное!​ Результат щелкаете правой​ файла​ For i =​​ не начинаются на​​ dic(iText(i)) Nextобъясните пожалуйста​​ которые начинаются на​​MCH​

​200?’200px’:»+(this.scrollHeight+5)+’px’);»>=СУММПРОИЗВ((Base!$A$2:$A$999=Лист1!$A$2)*(Base!$M$2:$M$999>=Лист1!L1)*(Base!$M$2:$M$999 — макрос не​​1. В ячейке​ перед буквой столбца​Нажимайте кнопку​​ Если поле​ ​Ячейка целиком​

support.office.com

Массовая замена значений в excel по маске

​. Например, чтобы найти​ внизу страницы. Для​
​: Я сделал фото​Power Query -​
​ кнопкой также по​
​Sanja​ 0 To UBound(iText)​
​ Анат или Уру​

​ — это наполнение​​ 05056280 или 06056280​
​: У Вас всегда​ работает, выдает​
​ В2 выделите часть​

​ и после нее,​​Найти далее​Заменить на​.​ данные, которые содержат​ удобства также приводим​ Print screen-ом, нигде​ для меня новинка​ смарт-таблице и нажимаете​: Будьте готовы к​

Массовая замена значений в ячейках (Иное/Other)

​ iTemp = dic(iText(i))​​ или Инокен​
​ словаря?​ или 01056280 ,​ так обозначаются контейнеры​#ЗНАЧ!​ формулы B1 и​ и для последующих​, пока не перейдете​недоступно, откройте вкладку​Если вы хотите найти​ «?», вы введите​
​ ссылку на оригинал​ нет опции «​ разбираюсь как он​ обновить. Скрипт вытащит​ тормозам. Если не​ Next Set myRng​Код из примера​И что такое​ подскажите как его​
​ (номер, пробел, страна)?​Код200?’200px’:»+(this.scrollHeight+5)+’px’);»>=СУММПРОИЗВ((Base!$M$2:$M$999>=Лист1!B1)*(Base!$M$2:$M$999​ нажмите 2 раза​ столбцов аналогично. например​ к вхождению, которое​Заменить​ текст или числа​​~?​​ (на английском языке).​ заменить в выделенной​​ работает, крутая штука​​ из текста только​ актуально форматирование на​ = Intersect(Range(«A:B»), ActiveSheet.UsedRange)​Sub Макрос2() Dim​
​ «flag» — встречался​ модернизировать что бы​»1239420938 Турция»​Gustav​ F4. Должно получиться​ $B$1 и $C$1​

​ вы хотите изменить.​​.​

​ с определенным форматированием,​​как критерии поиска.​Функции поиска и замены​ области»!​ (компания подарила офис​
​ значения подходящие под​ листе, то можно​ flag = False​ iText, iKey, iTemp,​
​ с этими «флагами»,​​ удалили все кроме​​»1239420938 Израиль»​​: Не знаю, у​​ B$1. C C1​

​ одновременно с $D$1​​Нажмите кнопку​При необходимости поиск можно​ нажмите кнопку​Нажмите кнопку​ в Excel используются​Гиперссыльный​ 365 — а​

​ описанное вами условие.​​ переделать на массивах/словарях​​ For Each cl​​ i&, flag As​ но до конца​ 05056280 и 06056280​если да, то​ меня всё работает.​ — аналогично​ и $E$1.​Заменить​
​ отменить, нажав клавишу​Формат​
​Параметры​ для поиска в​:​ я еще в​Если будет образец​Marat_Mamedov​ In myRng For​
​ Boolean Dim myRng​ не понял)) и​ и 01056280 (указать​
​ подойдет формула:​
​ Ввожу Ваши формулы,​
​2. Протяните формулу​Второй вопрос: путем​
​. Чтобы обновить все​ ESC.​и выберите нужные​, чтобы определить дополнительные​
​ книге необходимой информации,​
​Pelena​
​ 2007-2010 завис.) прогресс​​ текстового файла с​​: Программа не выдержала​​ Each iKey In​​ As Range, cl​ If cl.Value Like​ в макросе те​

​=ПСТР(E7;ПОИСК(» «;E7&» «)+1;99)​​ выделяю ячейки, запускаю​
​ в В2 на​ функцией «замена» -​ вхождения, не останавливаясь​Чтобы заменить одно или​
​ параметры в диалоговом​
​ условия поиска при​ например определенного числа​: Дык, Excel по​
​ не стоит на​ парой строк -​

​ , вылет. Подскажите​​ dic.Keys If cl.Value​ As Range, delRng​ «*» & iKey​
​ которые нужно оставить​
​Если список стан​ макрос, после макроса​
​ нужный диапазон.​
​ как сделать массовую​ на каждом из​ все совпадения с​ окне​ необходимости:​ или текстовой строки.​ умолчанию так работает:​ месте​

​ смогу подогнать скрипт​​ о чем речь​ Like «*» &​ As Range Dim​ & «*» Then​ а не удалить​ ограничен, и нужно​ имею в ячейках​​Ну или макрос:​
​ замену с добавлением​
​ них, нажмите кнопку​ введенным текстом, нажмите​​Найти формат​
​Для поиска данных на​

​На вкладке​​ если выделен диапазон,​Макрос автора -​ под него.​ не совсем понимаю.​ iKey & "*"​ dic As Object​ - это, чтобы​
​ т.к. оставить нужно​
​ найти название страны,​ абсолютные формулы:​200?'200px':''+(this.scrollHeight+5)+'px');">Sub replaceRef()​ знака '$'? Т.е.​Заменить все​ кнопку​.​ листе или во​

excelworld.ru

Использование поиска по маске в функции ЕСЛИ

​Код200?’200px’:»+(this.scrollHeight+5)+’px’);»>=СУММПРОИЗВ((Base!$M$2:$M$999>=Лист1!$B$1)*(Base!$M$2:$M$999 Может, в​​ 65 To 90​ параметр​Совет:​или​

​ ячейках какие-то проблемы,​​ 1, «$» &​

​1 и заменяем на​​ в верхнем или​.​ можно удалить все​вариант​Найти и выделить​Гиперссыльный​ времени в таком​ варианты решения вашей​»cl»​

​ For Next If​​ CreateObject(«Scripting.Dictionary») For i​
​ необходимости?​

​Sanja​​=ПРОСМОТР(2;1/ЕЧИСЛО(ПОИСК({«Турция»:»Израиль»:»Египет»};E7));{«Турция»:»Израиль»:»Египет»})​

planetaexcel.ru

Удаление ячеек по маске

​ какие-нибудь «левые» значения?​​ Chr(i) & «$»​
​ $​ нижнем регистре, нажмите​Microsoft Excel сохраняет параметры​ условия в поле​на листе​
​.​: Просто, я пытался​ виде:​ задачи и на​для​ Not flag Then​ = 0 To​SAS888​: Проверьте Sub Макрос2()​MCH​ Тяжело лечить по​ & 1, xlPart​%​ кнопку​ форматирования, которые можно​Найти​или​Выполните одно из указанных​ сделать как вы​10.00-12.00​ VBA и на​»For each cl in​ If Not delRng​ UBound(iText) iTemp =​: —————————————————-​ Dim iText, iKey,​: очепятка: «…текстовой строки»​ переписке, не видя​Next i​$1. соответственно ко всем​Больше​ определить. Если вы​, а затем выбрать​в книге​ ниже действий.​ говорите: выделил столбец,​11.00-14.00​ SQL. Только как​ rng»​ Is Nothing Then​

​ dic(iText(i)) Next Set​​Sanja​ iTemp, i&, flag​lion9​ «пациента» (файла-примера с​End Sub​ буквам столбцов (до​и установите флажок​ еще раз выполнить​ ячейку с нужным​.​Чтобы найти текст или​ вызвал функцию «найти​и т. п.​ описано в правилах,​спасибо большое!!!​ Set delRng =​ myRng = Intersect(Range(«A:B»),​: Для Jack Famous,​ As Boolean Dim​: Просто офигенно! Спасибо​ этими формулами)…​Срабатывает​ и после) добавляется​Учитывать регистр​ поиск на листе​ форматированием в качестве​Для поиска данных в​ числа, выберите пункт​ и заменить», пытался​Мне нужно поменять​ ищите не вариант​Sanja​ Union(delRng, cl) Else​ ActiveSheet.UsedRange) flag =​Это способ наполнения​ myRng As Range,​ огромное. Функция вообще​lion9​на выделенном диапазоне​ знак ‘$’.​.​ данные и не​ примера. Щелкните стрелку​ строках или столбцах​

​Найти​​ заменить, а он​ формат на следующий:​ решения, который вам​: Можно забирать все​ Set delRng =​ False For Each​
​ словаря уникальными ключами,​ cl As Range,​ ничего не говорит​: Есть таблица со​и​Эта процедура необходима​Совет.​ удается найти символы,​ рядом с кнопкой​ выберите в поле​.​ падла заменяет во​с 10 до 12​ кажется правильным, а​

​ данные в память,​​ cl End If​

​ cl In myRng​​ с пустыми значениями,​
​ delRng As Range​ — никогда ничего​ списком, содержащим в​ищет только​
​ для автоматизации и​Видео не на​ которые вы знаете​Формат​Просматривать​Чтобы найти и заменить​ всем листе, игнорируя​с 11 до 14​ конкретно решение вашей​ обрабатывать (удалять/добавлять/изменять) их​
​ flag = False​ For Each iKey​ без генерации ошибки​ Dim dic As​ подобного не видел​ ячейках номера контейнеров​где вместо знака %​ ухода от ручного​ вашем языке? Попробуйте​ содержал сведения, может​, выберите пункт​вариант​ текст или числа,​ выделенный фрагмент. Чувствую​Пробую сделать это​ изначальной задачи.​

​ в памяти и​​ End If flag​ In dic.Keys If​
​В принципе, в​ Object iText =​ — полез по​ и страну, вида:​ — буквы от​ проставления знака ‘$’​ выбрать​ потребоваться снимите нужные​
​Выбрать формат из ячейки​по строкам​ выберите пункт​ себя полным идиотом​ через поиск и​Sanja​
​ ЗАМЕНЯТЬ новыми данными​
​ = False Next​ cl.Value Like «*»​ данном коде, применение​ Array(«05056280», «06056280», «01056280»)​ мануалам разбираться -​1239420938 Турция​ A до Z.​ к каждой букве​Скрытые субтитры​ параметры форматирования из​, а затем щелкните​или​Заменить​ (((​ замену. Старый формат​: Sub Макрос2() Dim​ старые на листе,​ If Not delRng​ & iKey &​ словаря просто дань​ ‘список слов на​ как же она​или​Digitalizer​ столбца.​.​ предыдущего поиска. В​ ячейку с форматированием,​по столбцам​.​Pelena​ времени находится, если​ iText, i&, k&,​ но при этом​ Is Nothing Then​ «*» Then flag​ моде. Т.к. в​ удаление Set dic​ работает-то хоть :)​1239420938 Израиль​: Nic70y​Nic70y​Нужно массово заменить значения​ диалоговом окне​

​ которое требуется найти.​​.​
​В поле​: Приложите файл и​ в графе поиска​ myArr(), newArr() On​ будет утеряно форматирование​ delRng.Delete Shift:=xlShiftUp MsgBox​ = True Exit​ итоге все равно​ = CreateObject(«Scripting.Dictionary») For​MCH​Хотелось бы, чтобы​да вот и​: Ctrl+h не пробовали?​ в ячейках .​Поиск и замена​Выполните одно из указанных​Для поиска данных с​Найти​ поясните что на​ ввести *.*-*.* (*,​ Error Resume Next​ ячеек (цвета шрифтов,​ «ненужные строки удалены!»,​ For End If​ перебираем ключи, а​ i = 0​: ЕЧИСЛО — лишнее:​ в следующем столбце​ приходилось F4 жать​Digitalizer​Пример, в ячейках​перейдите на вкладку​ ниже действий.​ конкретными свойствами выберите​введите текст или​ что Вы хотите​ как я помню,​ iText = Array(«Анат*»,​ курсив и прочее)​ 64, «конец» End​ If flag Then​ их не так​ To UBound(iText) iTemp​=ПРОСМОТР(2;1/ПОИСК({«Турция»:»Израиль»:»Египет»};E8);{«Турция»:»Израиль»:»Египет»})​ по каждой такой​ по 50 раз​: так я и​ значение :​

​Поиск​​Чтобы найти текст или​ в поле​ числа, которые нужно​ поменять​ в маске -​ «Уру*», «Инокен*») ‘список​Marat_Mamedov​ Sub​ Exit For Next​ уж много, и​ = dic(iText(i)) Next​
​Владимир​ ячейке выводилась соответствующая​ :)​ спрашиваю каким образом​1805/7957-6890​и нажмите кнопку​
​ числа, нажмите кнопку​Область поиска​ искать, или щелкните​Serge_007​ это любой знак​ слов на НЕудаление​: «но при этом​Marat_Mamedov​ If Not flag​ можно обойтись обычным​ Set myRng =​: =ЗАМЕНИТЬ(A1;1;НАЙТИ(» «;A1);»»)​ страна. Конструкция вида:​Manyasha​ это можно сделать​

​Нужно заменить на​​Параметры​Найти все​вариант​ стрелку в поле​: Такой «опции» не​

​ или любые несколько​​ myArr = Intersect(Range(«A:B»),​ будет утеряно форматирование​: Просто супер! Спасибо​ Then If Not​

​ массивом.​​ Intersect(Range(«A:B»), ActiveSheet.UsedRange) flag​Marat_Mamedov​=ЕСЛИ(E7=»Турция*»;»Турция»;»Израиль»)​​да да да,​​ в «замене».​​ :​, чтобы открыть параметры​
​или​

​формулы​​Найти​ существует в Excel​ знаков) .​ ActiveSheet.UsedRange).Value ReDim newArr(1​ ячеек (цвета шрифтов,​ большое теперь пойду​ delRng Is Nothing​ЦитатаJack Famous написал:​ = False For​: Здравствуйте!​

​работать не хочет.​​ об этом и​как сделать маску​1805-7957/6890​ форматирования. Щелкните стрелку​Найти далее​,​и нажмите кнопку​ за ненадобностью​Кто подскажет, что​

​ To UBound(myArr, 1),​​ курсив и прочее)»​ на боевых реестрах​

​ Then Set delRng​​ И что такое​ Each cl In​На форме нашел​ Как можно решить​ речь :)​ на те значения​Abram pupkin​ рядом с полем​.​
​значения​ последнего поиска в​Цитата​
​ мне вписать в​ 1 To UBound(myArr,​
​ — такой вариант​ удалять записи там​ = Union(delRng, cl)​ «flag»Если посмотрите выше​ myRng For Each​ макрос который удаляет​ эту задачу? И​спасибо за макрос​ которые не надо​: так ?​Формат​Совет:​
​или​ списке.​Pelena, 26.07.2015 в​ графе «Заменить на»?​ 2)) k =​
​ подходит там вообще​ записей под 1,5​ Else Set delRng​ по коду, то​ iKey In dic.Keys​ ячейки со сдвигом​ каким будет решение,​ ) помогло​ менять.​=ПОДСТАВИТЬ (ПОДСТАВИТЬ (ПОДСТАВИТЬ​и нажмите кнопку​ При нажатии кнопки​примечания​В условиях поиска можно​

​ 14:13, в сообщении​​Орбитальная группировка​ 1 flag =​ нет ничего такого​ млн ячеек (пришлось​ = cl End​ увидите, что это​ If cl.Value Like​ вверх по условию​ если контрагентов будет​Gustav​По типу: Лист1!​ (A2;»/»;»»);»-«;»/»);»»;»-«)​Очистить​Найти все​.​ использовать подстановочные знаки,​ № 2200?’200px’:»+(this.scrollHeight+5)+’px’);»>во всех​: … надо ;##…реш0тки​ False For i​ в формате ячеек​ экспортировать в две​ If flag =​ обычная переменная типа​ «*» & iKey​ :​ не двое, а​: Если только правильно​B​*пробелы убрать​.​, каждого экземпляра условия,​Примечание:​ например вопросительный знак​ версиях НАЙТИ/ЗАМЕНИТЬ работает​ а не звёзды​ = 1 To​

​ , просто текст.​​ колонки что бы​ False End If​
​ Boolean. В коде​ & «*» Then​Sub Макрос2() Dim​ трое? Вообще, поддерживают​ понял задачу, требовалось,​1 в Лист1!$​Полосатый жираф алик​Для поиска текста или​ которые вы ищете​ ​
​ (?) и звездочку​ по выделенному диапазону,​или between or​

planetaexcel.ru

Помогите составить маску для замены в excel

​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Sub io()​​$1​ тупых примеров, а​
​ также можно использовать​

Как настроить НАЙТИ и ЗАМЕНИТЬ только в выделенной области? (Формулы/Formulas)

​ нужное вхождение в​​,​Звездочка используется для поиска​ только одна ячейка,​: В Excel 2010​ j = 1​ писал))​ Excel.​ Then delRng.Delete Shift:=xlShiftUp​ cl.Value Like «*»​ If If flag​ Variant Dim i​ вообще?​Selection.Formula = Application.ConvertFormula(Selection.Formula,​

​Nic70y​​ описать, что действительно​ функции ПОИСК и​ списке сделает ячейки​значения​ любой строки знаков.​ то по всему​ почему-то отсутствует функция​

​ To UBound(myArr, 1)​​PooHkrd​Не смог найти​ MsgBox «ненужные строки​ & iKey &​ Then Exit For​

​ As Long iText​​mouse​

​ xlA1, xlA1, xlAbsolute)​​: Этим средством думаю​ нужно? И по​ НАЙТИ.​ active. Можно сортировать​и​ Например, если ввести​ листуВсе верно, так​

​ НАЙТИ И ЗАМЕНИТЬ​​ For x =​: Я правильно понимаю,​ как настроить умный​ удалены!», 64, «конец»​ «*»ЦитатаJack Famous написал:​ Next If Not​ = Array(«05056280*»,»06056280*»,»01056280*») ‘список​: может так​End Sub​ ни как, перебирайте​ каким адресам расположено​

​С помощью функции «Поиск​​ результаты​примечания​г*д​ и есть во​

​ при выделении столбца​​ 0 To UBound(iText)​ что по факту​ экспор в ексель​
​ End Sub​​ чтобы можно было​ flag Then If​ слов на удаление​=ЕСЛИ(ЕОШ(НАЙТИ(«Турция»;E7));»Израиль»;»Турция»)​P.S. Четвертый параметр​ весь алфавит, выделяя​ то, что будем​ и замена» можно​Найти​доступны только на​, то будут найдены​

excelworld.ru

​ всех версиях​