Sub Example()
Dim objDict As Dictionary
Dim objRange As Range, objCell As Range, strTemp As String
Dim arrKeys, arrTemp, i As Integer, j As Integer
On Error Resume Next
Set objRange = Worksheets(1).Cells.SpecialCells(xlCellTypeConstants, xlTextValues)
If Err.Number = 0 Then
Set objDict = New Dictionary
objDict.CompareMode = TextCompare
For Each objCell In objRange
strTemp = objCell.Value
If objDict.Exists(strTemp) Then
objDict.Item(strTemp) = objDict.Item(strTemp) & " " & objCell.Address
Else
objDict.Add strTemp, objCell.Address
End If
Next
arrKeys = objDict.Keys
With Worksheets(2)
For i = 0 To objDict.Count - 1
.Cells(i + 1, 1).Value = arrKeys(i)
arrTemp = Split(objDict(arrKeys(i)))
.Cells(i + 1, 2).Value = UBound(arrTemp) + 1
For j = 0 To UBound(arrTemp)
.Cells(i + 1, j + 3).Value = arrTemp(j)
Next
Erase arrTemp
Next
End With
Set objDict = Nothing
Set objRange = Nothing
Worksheets(2).Activate
Else
Err.Clear
MsgBox "Указанный лист не имеет ячеек, содержащих текст.", vbExclamation
End If
End Sub
Сориентируйте, плз, по созданию массива (VBA)
Пытаюсь собрать массив из входов указателя из документа Ворд. "Вход указателя" - это место в тексте, где находится упоминание того или иного объекта (фамилия, нас. пункт, название фирмы и пр.), который будет указан в конце документа в списке указателя (в ворде: меню-вставка-ссылка- оглавл и указатели-ОК.) Я хочу сделать массивную переменную из таких входов. Т.е. нахожу первый вход указателя (в ворде в режиме отображения служебных символов [Ctrl+Sh+8] он отмечен как {XE "название"}. Надо вытащить это название и поместить в первую ячейку. Потом найти сл. вход и во вторую. Если какой-то вход окажется повторным, надо поместить его в другое измерение этого массива (т.к. входы могут, ессно, повторяться на разных страницах документа).
Сложно ли это сделать (в общих чертах). Как вообще записать занесение элемента в коллекцию/массив?
у меня пока так:
Но элементы iUK получаются пустыми.
Сложно ли это сделать (в общих чертах). Как вообще записать занесение элемента в коллекцию/массив?
у меня пока так:
Код:
Dim mCnt As Byte
Dim mtext As String
Dim iUK As New Collection
For i = 1 To ActiveDocument.Fields.Count ' перебираем воды указателя
If ActiveDocument.Fields(i).Type = wdFieldIndexEntry Then
mtext = ActiveDocument.Fields(i).Code.Text ': Stop
mtext = Replace(mtext, " XE ", "")
mtext = Replace(mtext, Chr(34), "")
mtext = RTrim(mtext)
' Stop
iUK.add Item = i, Key:=mtext
End If
Next i
Dim mtext As String
Dim iUK As New Collection
For i = 1 To ActiveDocument.Fields.Count ' перебираем воды указателя
If ActiveDocument.Fields(i).Type = wdFieldIndexEntry Then
mtext = ActiveDocument.Fields(i).Code.Text ': Stop
mtext = Replace(mtext, " XE ", "")
mtext = Replace(mtext, Chr(34), "")
mtext = RTrim(mtext)
' Stop
iUK.add Item = i, Key:=mtext
End If
Next i
Если Вы хотите выудить исключительно уникальные названия, не надо заводить никаких вторых-десятых измерений массивов. Просто воспользуйтесь тем свойством коллекций, что в коллекцию нельзя поместить больше одного элемента с одинаковым ключом. В коде ниже это показано. Тогда возникает ошибка, которую можно благополучно проигнорить и элемент не попадет в коллекцию
Код:
Dim colFields As New Collection
Dim f As Field, fieldText As String
'Идем по всем полям документа
For Each f In ActiveDocument.Fields
'Это наше поле?
If f.Type = wdFieldIndexEntry Then
'Да. Получим текст его кода
fieldText = f.Code.Text
'Уберем все служебные символы (кавычки и фигурные скобки)
fieldText = Replace(fieldText, "{XE """, vbNullString)
fieldText = Replace(fieldText, """}", vbNullString)
'Безопасно пытаемся добавить элемент в коллекцию
On Error Resume Next
'В качестве индекса возьмем текст кода поля, заменив все пробелы символом подчеркивания
colFields.Add fieldText, Replace(fieldText, " ", "_")
On Error GoTo 0
End If
Next
Dim f As Field, fieldText As String
'Идем по всем полям документа
For Each f In ActiveDocument.Fields
'Это наше поле?
If f.Type = wdFieldIndexEntry Then
'Да. Получим текст его кода
fieldText = f.Code.Text
'Уберем все служебные символы (кавычки и фигурные скобки)
fieldText = Replace(fieldText, "{XE """, vbNullString)
fieldText = Replace(fieldText, """}", vbNullString)
'Безопасно пытаемся добавить элемент в коллекцию
On Error Resume Next
'В качестве индекса возьмем текст кода поля, заменив все пробелы символом подчеркивания
colFields.Add fieldText, Replace(fieldText, " ", "_")
On Error GoTo 0
End If
Next
Цитата: verholom
Если Вы хотите выудить исключительно уникальные названия, не надо заводить никаких вторых-десятых измерений массивов. Просто воспользуйтесь тем свойством коллекций, что в коллекцию нельзя поместить больше одного элемента с одинаковым ключом. В коде ниже это показано. Тогда возникает ошибка, которую можно благополучно проигнорить и элемент не попадет в коллекцию
Как раз нужно, что бы все вошли. Я потом буду считать, сколько раз было одинак. вхождений и сделаю соотв. метку в тексте. Но в любом случае спасибо. Теперь, после вашей подсказки, мой код будет выглядеть более профессионально (к тому же я неправильно указывал аргументы в инструкции add. Теперь вижу как надо). И кроме того я узнал, что с массивом строк будет головняк с нулевой нумерацией первого элемента, а в коллекциях все по-людски - с номера 1. Option explicit с Option Base не годится, т.к. придется все макросы перещупывать на предмет инициализации переменных. А это оч. долго. Спасибо.
Dmitry2064, советую для такой задачи использовать объект Dictionary из инструментария WSH. Это даст Вам больше возможностей.
Для создания входа указателя, например, в качестве ключей формируемого словаря можно задавать значения интересующих Вас строк (разумеется, ключи будут уникальны), а в качестве соответствующих ключам элементов можно указывать в текстовой же форме номера страниц, на которых эти строки встречаются. Понятно, что номера страниц надо указывать через какой-либо разделитель (скажем, скажем пробел). Его при дальнейшей обработке несложно будет отфильтровать.
Для создания входа указателя, например, в качестве ключей формируемого словаря можно задавать значения интересующих Вас строк (разумеется, ключи будут уникальны), а в качестве соответствующих ключам элементов можно указывать в текстовой же форме номера страниц, на которых эти строки встречаются. Понятно, что номера страниц надо указывать через какой-либо разделитель (скажем, скажем пробел). Его при дальнейшей обработке несложно будет отфильтровать.
Я сделал через коллекцию:
For i = 1 To ActiveDocument.Fields.Count ' собираем в коллекцию все входы
If ActiveDocument.Fields(i).Type = wdFieldIndexEntry Then
mtext = ActiveDocument.Fields(i).Code.Text ': Stop
mtext = Replace(mtext, " XE ", vbNullString)
mtext = Replace(mtext, Chr(34), vbNullString)
mtext = Replace(mtext, Chr(92), Chr(34))
mtext = RTrim(mtext)
очистили текст от служеб. символов
mCOll.add Item:=mtext, Key:=CStr(i) ' отправили в коллекцию
End If
Next i
Теперь еще раз обходим все входы (с конца в начало, т.к. лучше удалять все входы чтобы не оставалось грязи после конвертации текста):
Selection.EndKey Unit:=wdStory
'For nCnt% = 0 To UBound(mColl)
With Selection.Find
.ClearFormatting: .Text = "^d": .MatchWildcards = False: .Forward = False
.Execute
End With
mCnt = mCOll.Count
While Selection.Find.Found
For k = 1 To mCnt ' считаем кол-во повторов в коллекции с первого по текущий элемент
If mCOll(k) = mCOll(mCnt) Then
povtor = povtor + 1
End If
Next k
И получаем номер элемента+номер_кол-во повторов. Из этих цифр и формируется метка для входа указателя.
For i = 1 To ActiveDocument.Fields.Count ' собираем в коллекцию все входы
If ActiveDocument.Fields(i).Type = wdFieldIndexEntry Then
mtext = ActiveDocument.Fields(i).Code.Text ': Stop
mtext = Replace(mtext, " XE ", vbNullString)
mtext = Replace(mtext, Chr(34), vbNullString)
mtext = Replace(mtext, Chr(92), Chr(34))
mtext = RTrim(mtext)
очистили текст от служеб. символов
mCOll.add Item:=mtext, Key:=CStr(i) ' отправили в коллекцию
End If
Next i
Теперь еще раз обходим все входы (с конца в начало, т.к. лучше удалять все входы чтобы не оставалось грязи после конвертации текста):
Selection.EndKey Unit:=wdStory
'For nCnt% = 0 To UBound(mColl)
With Selection.Find
.ClearFormatting: .Text = "^d": .MatchWildcards = False: .Forward = False
.Execute
End With
mCnt = mCOll.Count
While Selection.Find.Found
For k = 1 To mCnt ' считаем кол-во повторов в коллекции с первого по текущий элемент
If mCOll(k) = mCOll(mCnt) Then
povtor = povtor + 1
End If
Next k
И получаем номер элемента+номер_кол-во повторов. Из этих цифр и формируется метка для входа указателя.
Цитата: Dmitrii
Dmitry2064, советую для такой задачи использовать объект Dictionary из инструментария WSH. Это даст Вам больше возможностей.
Для создания входа указателя, например, в качестве ключей формируемого словаря можно задавать значения интересующих Вас строк (разумеется, ключи будут уникальны), а в качестве соответствующих ключам элементов можно указывать в текстовой же форме номера страниц, на которых эти строки встречаются. Понятно, что номера страниц надо указывать через какой-либо разделитель (скажем, скажем пробел). Его при дальнейшей обработке несложно будет отфильтровать.
Для создания входа указателя, например, в качестве ключей формируемого словаря можно задавать значения интересующих Вас строк (разумеется, ключи будут уникальны), а в качестве соответствующих ключам элементов можно указывать в текстовой же форме номера страниц, на которых эти строки встречаются. Понятно, что номера страниц надо указывать через какой-либо разделитель (скажем, скажем пробел). Его при дальнейшей обработке несложно будет отфильтровать.
Так это вроде и будет типа коллекции. В элементе с порядковым номером таким-то записано такое-то название. Вроде это тоже самое что и Dictionary? (только противоположный с коллекцией порядок аргументов).
Цитата: Dmitrii
Dmitry2064, советую для такой задачи использовать объект Dictionary из инструментария WSH. Это даст Вам больше возможностей.
Для создания входа указателя, например, в качестве ключей формируемого словаря можно задавать значения интересующих Вас строк (разумеется, ключи будут уникальны), а в качестве соответствующих ключам элементов можно указывать в текстовой же форме номера страниц, на которых эти строки встречаются. Понятно, что номера страниц надо указывать через какой-либо разделитель (скажем, скажем пробел). Его при дальнейшей обработке несложно будет отфильтровать.
Для создания входа указателя, например, в качестве ключей формируемого словаря можно задавать значения интересующих Вас строк (разумеется, ключи будут уникальны), а в качестве соответствующих ключам элементов можно указывать в текстовой же форме номера страниц, на которых эти строки встречаются. Понятно, что номера страниц надо указывать через какой-либо разделитель (скажем, скажем пробел). Его при дальнейшей обработке несложно будет отфильтровать.
А как в один элемент добавить сразу несколько номеров страниц/мест встречи?
Цитата: Dmitry2064
Так это вроде и будет типа коллекции...
Да. Однако возможностей, как уже сказано, будет немного больше.
Для иллюстрации был взят произвольный текст, вставлен на лист рабочей книги Excel и распределён по ячейкам так, что в одной ячейке оказалось по одному слову (знаки препинания были удалены).
Результаты обработки были выведены на другой лист книги следующим образом:
- первый столбец содержит не повторяющийся список слов, из которых состоит исходный текст;
- второй столбец содержит количество повторений текущего слова в исходном тексте;
- третий и, возможно, последующие столбцы содержат адреса ячеек, в которых встречается текущее слово в исходном тексте.
Код:
P.S.
Excel был использован лишь потому, что я не пишу макросов для Word.
Большое спасибо за пример. Теперь есть, от чего оттолкнуться. Буду разбираться. )