Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/6: Рейтинг темы: голосов - 6, средняя оценка - 5.00
zamboga
1 / 1 / 0
Регистрация: 25.11.2016
Сообщений: 8
1

Расширение стандартного поиска. Как искать списки слов в Excel?

25.11.2016, 20:42. Просмотров 1109. Ответов 8

На входе задается список слов или фраз (например, через буфер обмена, или на отдельном листе).

Макрос ищет вхождение любого слова на ВСЕХ листах открытой книги, и выводит итоговую таблицу (но новом листе или в диалоговом окне), где указаны имя листа, адрес ячейки, найденное значение.
При клике переходим к ячейке, содержащей совпадение.

Если какое-то слово нигде не найдено, то напротив него пишется "не найдено".

Т.е. это тоже самое, что и стандартный поиск "CTRL+F", только задается не одно слово, а список слов (фраз).
Я не смог изменить все найденные в инете решения под себя и реализовать такой скрипт, т.к. у меня очень небольшие знания VBA (знаю только простейшие операции копировать/вставить, условие, цикл).

Итого.

На входе:
Список слов (фраз), каждая фраза с новой строки

На выходе:
1. Таблица или диалоговое окно, которая содержит все исходные фразы и все найденные ядреса ячеек. Т.е. эквивалент стандартного окна CTRL+F; поиск по всей книге; кнопка "Найти все".
2. Эта таблица или диалоговое окно содержит ссылки на ячейки, где встретились совпадения (как и окно стандартного поиска, чтобы можно было перейти к конкретной ячейке на конкретном листе)
3. Для слов и фраз, для которых ничего не найдено, выводится "не найдено".

Помогите мне, пожалуйста=)
0
Вложения
Тип файла: zip Поиск списка.zip (27.1 Кб, 2 просмотров)
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
25.11.2016, 20:42
Ответы с готовыми решениями:

Расширение стандартного инсталятора VS 2010
Всем привет! В VS есть Setup Project. Как в нем сделать, так что ко всем стандартным конам...

Расширение функционала стандартного QTableWidget
Требуется дополнить QTableWidget следующими возможностями: 1. Уметь выделять несколько Row в одну...

Как искать в пределах определённого сайта инфу (аналоги поиска GOOGLE)
У GOOGLE есть шаблон: site:сайт ключевые_слова Какие ещё поисковые системы дают возможность...

Расширение стандартного TextBox, пропали стандартные свойства
Решил расширить стандартный textbox. Создал проект dll. Единственное что мне нужно было изменить в...

Как задать цвет "крестику" стандартного поиска
Ну по сути вопрос в теме: Как задать цвет "крестику" стандартного поиска. Вот скрин для понимания:...

8
toiai
3181 / 936 / 216
Регистрация: 29.05.2010
Сообщений: 2,036
26.11.2016, 17:39 2
Вот один из вариантов:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub pr()
    Dim sh As Worksheet, t$
    PathFileTxt = ActiveWorkbook.Path & "\1. Искать это.txt"
    Workbooks.OpenText Filename:=PathFileTxt, Origin:=1251
    a = [a1].CurrentRegion.Value
    ActiveWorkbook.Close False
    With CreateObject("scripting.dictionary")
        For Each el In a
            .Item(el) = ""
        Next
        For Each sh In Sheets
            a = [a1].CurrentRegion.Value
            For i = 1 To UBound(a)
                For j = 1 To UBound(a, 2)
                    t = a(i, j)
                    If .exists(t) Then .Item(t) = .Item(t) & IIf(.Item(t) = "", "", ";") & sh.Name & "(" & i & "," & j & ")"
                Next
            Next
        Next
        Workbooks.Add
        ActiveSheet.[a1].Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
    End With
End Sub
Там где пусто в столбце B, значит не найдено.
1
zamboga
1 / 1 / 0
Регистрация: 25.11.2016
Сообщений: 8
28.11.2016, 14:29  [ТС] 3
Спасибо большое! Разобрать существующий скрипт я хоть как то могу=)
В общем, кое как разобрался, сам принцип понятен, но не полностью. Также нашел ошибки в работе скрипта.



Найденные ошибки:
1. Скрипт работает только в одном, текущем листе. Разве кусок
Visual Basic
1
For Each sh In Sheets
не для каждого листа должен работать? Тогда почему не работает?



2. Из-за наличия в исходнике на листах пустых строк (и пустых столбцов!) кусок
Visual Basic
1
a = [a1].CurrentRegion.Value
не верно определяет массив данных для дальнейшей работы. Из-за этого кучу строчек скрипт не проверяет. Я не знаю, как верно задать весь диапазон данных с учетом пустых строк и пустых столбцов кроме как
Visual Basic
1
Cells.Select
, и я не смог в этой части поправить скрипт (как я понимаю, "Cells.Select" работает с "экранными" данными, а ваш скрипт работает в памяти без обновления рабочей книги). Вопрос, как что поправить, чтобы скрипт верно отрабатывал с учетом пустых строк и столбцов а таблице, в которой ищем?



3. Скрипт ошибочно показывает найденные адреса на других страницах, хотя совпадений там нет. При этом скрипт "помнит" верный адрес с верного листа, и пихает этот же адрес для других листов. Скрин:



4. В качестве исходных данных для поиска могут быть не только слова, но и фразы, а искать надо слова. Каюсь, когда я описывал задачу, то в начале описания я написал "любого слова на ВСЕХ листах открытой книги", а вот в конце уже "все исходные фразы", хотя имел в виду слова. Например, добавьте в список "1. что искать.txt" слова "изготовить", "сделать" — они есть в составе фраз в таблице "2. искать тут.xlsx", но сейчас их не находит.
Я попробовал изменить скрипт и добавил разделение по столбцам так (записал макрос, по другому пока не умею, кроме простейших циклов и If-Then):
Visual Basic
1
2
3
4
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
Скрипт даже корректно определяет массив для работы, только вот в итоге ничего не находит. Вопрос, как сделать, чтобы скрипт искал по словам, а не по фразам? (разделитель -- пробел. Другие символы, типа "/", если будут по ходу встречаться, заменю на пробел сам, такой код мне по силам)



Вопросы по частям кода, с которыми ничего не понятно.

5. Почему сначала в переменную "a" присваивается массив данных для поиска, а потом в ЭТУ же переменную массив данных, в которых ищем? Т.е. одна и таже переменная используется для совершенно разных данных ("что ищем" и "где ищем"). Не из-за этого ли ошибка работы скрипта? Скрин1 , скрин2



6. Зачем забивать "пустотой" каждую строчку только что объявленного массива?
Visual Basic
1
2
3
For Each el In a
            .Item(el) = ""
        Next


7. Что происходит здесь и зачем нужен этот кусок:
Visual Basic
1
IIf(.Item(t) = "", "", ";")
Ведь как я понял, проверка на найденное значение происходит тут
Visual Basic
1
If .exists(t) Then
, и если значение найдено, то дописать к существующей строке "имя листа + адрес"
Visual Basic
1
sh.Name & "(" & i & "," & j & ")"
.
Т.е. все вроде понятно, кроме строки
Visual Basic
1
IIf(.Item(t) = "", "", ";")


8. Вы не могли бы объявить и описать все переменные в начале скрипта, т.к. не везде мне понятно, что переменная, а что — оператор?

Еще раз благодарю за помощь.
0
Hugo121
6476 / 2530 / 454
Регистрация: 19.10.2012
Сообщений: 7,598
28.11.2016, 14:41 4
Ух сколько текста, не осилил...
Совсем не нужно читать текст на лист, можно без этого обойтись:

Visual Basic
1
a = Split(CreateObject("Scripting.FileSystemObject").Getfile(ActiveWorkbook.Path & "\1. Искать это.txt").OpenasTextStream(1).ReadAll, vbNewLine)
И не будет проблем с пустыми строками, их правда есть смысл отсеивать при переборе массива (с нуля!)
0
28.11.2016, 14:41
zamboga
1 / 1 / 0
Регистрация: 25.11.2016
Сообщений: 8
28.11.2016, 15:04  [ТС] 5
Цитата Сообщение от Hugo121 Посмотреть сообщение
И не будет проблем с пустыми строками, их правда есть смысл отсеивать при переборе массива (с нуля!)
Если не ошибаюсь, то если отбросить пустые строки и столбцы при построении массива, то в итоге не получится верно вернуть адрес исходной ячейки, в которой нашли совпадение.
Т.е. нужно массив определять до крайней правой и крайней нижней ячейки, в которой есть какой-либо текст.
0
Hugo121
6476 / 2530 / 454
Регистрация: 19.10.2012
Сообщений: 7,598
28.11.2016, 16:08 6
Мой пример кода вернёт массив строк исходного текста - там нет никаких ячеек и столбцов.
0
zamboga
1 / 1 / 0
Регистрация: 25.11.2016
Сообщений: 8
28.11.2016, 16:36  [ТС] 7
Да, для списка на входе "что ищем" адреса, конечно, не нужны.

Мне нужны адреса для списка, в котором ищем. И тут уже схлопывать пустоты нельзя, или есть какое-то другое решение?

По остальным вопросам кто-нибудь может подсказать?
0
Vlad999
3169 / 1949 / 621
Регистрация: 02.11.2012
Сообщений: 5,013
29.11.2016, 08:51 8
6. так создается словарь с уникальными (не повторяющимися) значениями. Чтобы при дальнейшей проверке не гонять одно и тоже слово несколько раз.
7. это нужно чтобы, если слово встречается несколько раз то, отделить их символом ";"

Добавлено через 4 минуты
5. А почему нет, Словарь мы уже создали, взяли все что нам нужно из "а" и соответственно значения данного диапазона нам уже не нужны, можно использовать переменную "а" дальше.
1
zamboga
1 / 1 / 0
Регистрация: 25.11.2016
Сообщений: 8
01.12.2016, 14:10  [ТС] 9
Для тех, кто зайдет из поисковых систем.

Итоговый рабочий код:


Visual Basic
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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
Option Explicit
Sub pr3()
    Dim sh As Worksheet, t$
    Dim lLastRow As Long, lLastCol As Long, LastRow As Long, r As Long, i As Long, j As Long
    Dim PathFileTxt As String
    Dim dic As Object
    Dim el As Variant
    Dim a
    
    Windows("искать тут.xlsm").Activate
      
    'альтернативный способ задать массив без открытия файла. не подходит для фраз, состоящих более чем из одного слова.
    'a = Split(CreateObject("Scripting.FileSystemObject").Getfile(ActiveWorkbook.Path & "\ИД.txt").OpenasTextStream(1).ReadAll, vbNewLine)
      
    'открываем файл с Исходными Данными
    PathFileTxt = ActiveWorkbook.Path & "\ИД.txt"
    Workbooks.OpenText Filename:=PathFileTxt, Origin:=1251
    Columns("A:A").Select
      
    'разбиваем по столбцам чтобы найти слова, а не фразы
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
      
      
    'удаляем пустые строки
    LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count    'определяем размеры таблицы
    Application.ScreenUpdating = False
    For r = LastRow To 1 Step -1           'проходим от последней строки до первой
        If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete   'если в строке пусто - удаляем ее
    Next r
        
      
    'определяем последнюю ячейку с данными
    With ActiveSheet.UsedRange: End With
    lLastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
    lLastCol = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
      
    'задаем массив исходных данных
    'a = [a1].CurrentRegion.Value       'ограничивает диапазон первой пустой строкой/столбцом, не подходит
    a = Range(Cells(1, 1), Cells(lLastRow, lLastCol)).Value
    ActiveWorkbook.Close False
      
    'создаем словарь с исходными данными для поиска
    Set dic = CreateObject("scripting.dictionary")
    dic.comparemode = 1
    With dic
        For Each el In a
            If el <> "" Then
             .Item(el) = ""
            End If
        Next
'        MsgBox "Список ключей для поиска:" & vbLf & vbLf & Join(.keys, vbLf)
    'ищем в словаре совпадения на наших листах
        For Each sh In Sheets
            'определяем последнюю ячейку с данными
            With sh.UsedRange: End With
            lLastRow = sh.UsedRange.Row + sh.UsedRange.Rows.Count - 1
            lLastCol = sh.UsedRange.Column + sh.UsedRange.Columns.Count - 1
            'задаем массив
            a = sh.Range(sh.Cells(1, 1), sh.Cells(lLastRow, lLastCol)).Value
            'a = [a1].CurrentRegion.Value       'ограничивает диапазон первой пустой строкой/столбцом
            'забиваем словарь адресами ячеек, в которых есть совпадения с ИД
            For i = 1 To UBound(a)
                For j = 1 To UBound(a, 2)
                    t = a(i, j)
'                    MsgBox "=ГИПЕРССЫЛКА(""[" & Application.ActiveWorkbook.FullName & "]" & sh.Name & "!""&АДРЕС(" & i & ";" & j & ");""" & sh.Name & "!""&АДРЕС(" & i & ";" & j & "))"
                    If .exists(t) Then .Item(t) = .Item(t) & IIf(.Item(t) = "", "", "|") & "=ГИПЕРССЫЛКА(""[" & Application.ActiveWorkbook.FullName & "]" & sh.Name & "!""&АДРЕС(" & i & ";" & j & ");""" & sh.Name & "!""&АДРЕС(" & i & ";" & j & ";4))"
                Next
            Next
              
        Next
          
'вытаскиваем из словаря ключи (keys) и их значения (items)
        Dim aK, aI, aSP, s As String, ss As String
        Dim lMaxC As Long, lc As Long
        aK = .keys
        aI = .items
        ReDim a(1 To .Count, 1 To 100)
        For i = 1 To .Count
            a(i, 1) = aK(i - 1)
            s = .Item((aK(i - 1)))
            If s <> "" Then
                aSP = Split(s, "|")
                lc = UBound(aSP) + 1
                If lMaxC < lc Then
                    lMaxC = lc
                End If
                For lc = LBound(aSP) To UBound(aSP)
                    ss = aSP(lc)
                    a(i, lc + 2) = ss
                Next
            End If
        Next
 
        'создаем новую книгу
        Workbooks.Add
 
        'вставляем данные на лист
        ActiveSheet.[a1].Resize(.Count, lMaxC + 1).FormulaLocal = a
         
        Columns("B:XFD").EntireColumn.AutoFit
        Range("A1").Activate
        Application.ScreenUpdating = True
'        MsgBox "Done!"
'        ActiveWorkbook.Close False
    End With
 End Sub
1
Вложения
Тип файла: zip Скрипт поиска, рабочий вариант с примером.zip (35.7 Кб, 6 просмотров)
01.12.2016, 14:10
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
01.12.2016, 14:10

Отображение стандартного поиска
Скажите, как делается, чтобы поиск (сдандартная строка поиска, при нажатии на значок) отображался...

Убрать страницы записей из стандартного поиска
Здравствуйте, форумчане! Требуется ваша помощь. Мне необходимо убрать записи со стандартного...

Как создать выпадающие списки в Excel 2007
Как создать выподающие списки в Excel 2007 ?Если можно ,опишите пошагово .


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
9
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.