поиск зеркальных пар с помощью макроса

Дата: Понедельник, 10.06.2013, 15:06 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9

Репутация: 0 ±

Замечаний: 0% ±

Есть массив данных:

A000B0000A000C000D00C
в нем нужно найти зеркальные пары значений, например
A0 и 0A, при этом внутри может быть только значение не равное исходному(в данном случае A):
такие комбинации как
A0-B-0A, C0-D-0C

Заранее благодарю за помощь.

Сообщение отредактировал okom - Понедельник, 10.06.2013, 15:07

Дата: Понедельник, 10.06.2013, 16:22 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2744

Репутация: 1137 ±

Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1

По ходу верной дорогой в регулярные выражения Вам надо, товарищ! wink

Вот только не знаю (не помню), поддерживаются ли в VB-шных регулярках шаблоны с нумерованными переменными типа '([a-z])([a-z])21'. Надо проверить...

МОИ: Ник, Tip box: 41001663842605

Дата: Понедельник, 10.06.2013, 17:07 | Сообщение № 3

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2744

Репутация: 1137 ±

Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1

Цитата (Gustav)

поддерживаются ли в VB-шных регулярках шаблоны с нумерованными переменными типа '([a-z])([a-z])21'. Надо проверить

Ну, вроде работают... Для начала проверим следующей функцией принципиальное наличие зеркальных пар в строке:
[vba]

Код

Function HasMirrorPair(ByVal text As String) As Boolean
     Static regex As Object
     If regex Is Nothing Then
         Set regex = CreateObject("VBScript.RegExp")
     End If
     regex.IgnoreCase = True
     regex.Pattern = "(.)(.).*\2\1"
     HasMirrorPair = regex.Test(text)
End Function

[/vba]
Вызов функции в окне Immediate показывает их наличие:
[vba]

Код

? HasMirrorPair("A000B0000A000C000D00C")
True

[/vba]
Далее следует приступить собственно к поиску пар... (будет продолжено (мной)... надеюсь!) smile

МОИ: Ник, Tip box: 41001663842605

Дата: Понедельник, 10.06.2013, 17:15 | Сообщение № 4

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9

Репутация: 0 ±

Замечаний: 0% ±

тоже думал о нумерованных переменных. как вариант думал каждоой комбинации задавать свое значение, A0=x и т.д., 0A=y, пока ни к чему путному не привело, т.к. теряется последовательность массива исключением из него нулей.
Т.К. результатом должны быть возвращены значения комбинаций в новый массив.
примерно так:
если встретилась комбинация A0-B-0A то массив примет вид
500000000500С. ну и так далее, т.е. сохранена размерность массива с заменой букв на цифры в соответствии с логикой, применяемой искомых комбинациях..

Дата: Понедельник, 10.06.2013, 17:25 | Сообщение № 5

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2744

Репутация: 1137 ±

Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1

Чтобы не напрягаться, спёр пример из базы знаний Микрософт http://support.microsoft.com/kb/818802 (чуть пригладил):
[vba]

Код

Function TestRegExp(myPattern As String, myString As String)
    'Create objects.
    Dim objRegExp    As Object
    Dim objMatch     As Object
    Dim colMatches   As Object
    Dim RetStr       As String

    ' Create a regular expression object.
    Set objRegExp = CreateObject("VBScript.RegExp")

    'Set the pattern by using the Pattern property.
    objRegExp.Pattern = myPattern

    ' Set Case Insensitivity.
    objRegExp.IgnoreCase = True

    'Set global applicability.
    objRegExp.Global = True

    'Test whether the String can be compared.
    If (objRegExp.Test(myString) = True) Then

    'Get the matches.
     Set colMatches = objRegExp.Execute(myString)   ' Execute search.

     For Each objMatch In colMatches   ' Iterate Matches collection.
       RetStr = RetStr & "Match found at position "
       RetStr = RetStr & objMatch.FirstIndex & ". Match Value is '"
       RetStr = RetStr & objMatch.Value & "'." & vbCrLf
     Next
    Else
     RetStr = "String Matching Failed"
    End If
    TestRegExp = RetStr
End Function

[/vba]
В окне отладки находит два подходящих варианта:
[vba]

Код

? TestRegExp("(.)(.).*\2\1", "A000B0000A000C000D00C")
Match found at position 0. Match Value is 'A000B0000A'.
Match found at position 10. Match Value is '000C000D00'.

[/vba]

МОИ: Ник, Tip box: 41001663842605

Дата: Понедельник, 10.06.2013, 19:02 | Сообщение № 6

Группа: Редакторы

Ранг: Обитатель

Сообщений: 431

Репутация: 193 ±

Замечаний: 0% ±

[vba]

Код

'Test whether the String can be compared.
If (objRegExp.Test(myString) = True) Then

[/vba]
ms жгет biggrin

Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

YM 41001156540584 / WM WMR R21924176233

https://github.com/nervgh/vba

http://learn.javascript.ru/play/lFecd

Дата: Понедельник, 10.06.2013, 19:19 | Сообщение № 7

Группа: Редакторы

Ранг: Обитатель

Сообщений: 431

Репутация: 193 ±

Замечаний: 0% ±

Дата: Понедельник, 10.06.2013, 23:34 | Сообщение № 8

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9

Репутация: 0 ±

Замечаний: 0% ±

nerv,
при данном шаблоне такая вот штука вылезает....
T0B000T0C00000T000B000C000B00C000E0000C0000 "Match found at position 0. Match Value is 'T0B000T0C00000T'. ''т.е. при первом переборе алгоритм берет все внутренности до первого совпадения с Т а уж потом работает как надо.''
Match found at position 18. Match Value is 'B000C000B'.
Match found at position 29. Match Value is 'C000E0000C'.
"
(\D)(\d).[\1\2]*[^\1\2]+[\1\2]*\2\1

PS. Если в конец строки добавить T, то алгоритм выдает всю строку T0B000T0C00000T000B000C000B00C000E0000C0000T

Дата: Понедельник, 10.06.2013, 23:36 | Сообщение № 9

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9

Репутация: 0 ±

Замечаний: 0% ±

Густав, спасибо.
использовал твой макрос с шаблоном Nerv'a
как и писал, не идет первый перебор строки sad

берет все подряд. см. выше.

Дата: Вторник, 11.06.2013, 15:08 | Сообщение № 10

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2744

Репутация: 1137 ±

Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1

okom,
попробуйте по отдельности "жадную" квантификацию:

[vba]

Код

? TestRegExp("(\D)(\d).*\2\1", "T0B000T0C00000T000B000C000B00C000E0000C0000")
Match found at position 0. Match Value is 'T0B000T0C00000T'.
Match found at position 18. Match Value is 'B000C000B'.
Match found at position 29. Match Value is 'C000E0000C'.

[/vba]

и "ленивую" квантификацию (отличие шаблона - добавился знак вопроса после звездочки):

[vba]

Код

? TestRegExp("(\D)(\d).*?\2\1", "T0B000T0C00000T000B000C000B00C000E0000C0000")
Match found at position 0. Match Value is 'T0B000T'.
Match found at position 8. Match Value is 'C00000T000B000C'.
Match found at position 29. Match Value is 'C000E0000C'.

[/vba]

Подробнее про "жадную и ленивую" - в Википедии (для начала изысканий): http://ru.wikipedia.org/wiki....8%D1%8F

МОИ: Ник, Tip box: 41001663842605

Сообщение отредактировал Gustav - Вторник, 11.06.2013, 15:18

Дата: Вторник, 11.06.2013, 16:17 | Сообщение № 11

Группа: Редакторы

Ранг: Обитатель

Сообщений: 431

Репутация: 193 ±

Замечаний: 0% ±

Цитата (okom)

при данном шаблоне такая вот штука вылезает....

не понял, что не так. Заменил только текст http://learn.javascript.ru/play/xRePbc

Что должно было найти в этой строке?

UPD: Понял. Используйте шаблон последний шаблон Густва. Конструкция [^\1] не работает.

UPD2:так должно работать http://learn.javascript.ru/play/Ibnmo

Сообщение отредактировал nerv - Вторник, 11.06.2013, 16:41

Дата: Вторник, 11.06.2013, 17:49 | Сообщение № 12

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9

Репутация: 0 ±

Замечаний: 0% ±

В одном и другом случае пропускается комбинация: T0C00000T

Дата: Вторник, 11.06.2013, 19:32 | Сообщение № 13

Группа: Редакторы

Ранг: Обитатель

Сообщений: 431

Репутация: 193 ±

Замечаний: 0% ±

Цитата (okom)

В одном и другом случае пропускается комбинация: T0C00000T

решается алгоритмически:

регулярка - поиск первого совпадения

- найти подстроку
- найдена? продолжить поиск с символа, следующего за первым найденной подстроки