Выделение повторяющихся значений в разных столбцах более чем двух книг

[Hugo121]

В файле с ошибкой не нашлось "Инвентарный номер" - я бы вручную открыл, исправил, ну в общем взял под контроль, а не молча пропустил файл как будто всё ОК.

[IgorGO]

я экспериментировал в своей папке, у меня открывалось еще куча всяких файлов не имеющих отношение к делу поэтому, реально, в файле на первом листе нет фразы "Инвентарный номер" - значит это левый файл (на этой же проверке отбрасываются и не обрабатываются открытый файл с макросом или Personal (если он есть))

и вообще это программа чтобы сличить инвентарные номера, поэтому фраза "Инвентарный номер" ключевая

[YustasRighno]

Сообщение от IgorGO

я экспериментировал в своей папке, у меня открывалось еще куча всяких файлов не имеющих отношение к делу поэтому, реально, в файле на первом листе нет фразы "Инвентарный номер" - значит это левый файл (на этой же проверке отбрасываются и не обрабатываются открытый файл с макросом или Personal (если он есть))

и вообще это программа чтобы сличить инвентарные номера, поэтому фраза "Инвентарный номер" ключевая

почему-то возникали ошибки, если расширение xls, а не xlsx. Пересохранил всё в xlsx, после старта макроса открывает всё без проблем, но при сличении номеров снова ошибка "91" и ссылка на ": If rg.Address = adr Then"

Подпись видел, красивая)

[IgorGO]

процедуру Sub AddIN2Diction заменили??

[IgorGO]

да, извините

следующая завалится в том же месте по той-же причине...
замените еще это

Sub FindINPosition()
  Dim i As Long, wb As Workbook, rg As Range, adr As String, ks
  ks = DIN.keys
  For Each wb In Workbooks
    With wb.Worksheets(1)
      For i = 0 To UBound(ks)
        Set rg = .Cells(1):  Application.StatusBar = wb.Name & "   N " & i
        Set rg = .Cells.Find(ks(i), rg, xlValues, xlPart)
        If Not rg Is Nothing Then
          adr = rg.Address
          Do While True
            DIN(ks(i)) = DIN(ks(i)) & Chr(9) & "<<" & wb.Name & ">> " & rg.Address(False, False)
            Set rg = .Cells.Find(ks(i), rg, xlValues, xlPart)
            If rg Is Nothing Then Exit Do
            If rg.Address = adr Then Exit Do
          Loop
        End If
      Next
    End With
  Next
End Sub

[YustasRighno]

Сообщение от IgorGO

замените текст процедуры Sub AddIN2Diction

Sub AddIN2Diction()
  Dim wb As Workbook, r As Long, er As Long, rg As Range, adr As String, id As String
  For Each wb In Workbooks
    With wb.Worksheets(1)
      Set rg = .Cells(1)
      Set rg = .Cells.Find("Инвентарный номер", rg, xlValues, xlPart)
      If Not rg Is Nothing Then
        adr = rg.Address
        Do While True
          For r = rg.Row + 1 To .Cells(.Rows.Count, 1).End(xlUp).Offset(1, rg.Column - 1).End(xlUp).Row
            id = TrimId(CStr(.Cells(r, rg.Column)))
            If id <> "" Then
              If Not DIN.exists(id) Then
                DIN.Add id, "<<" & wb.Name & ">> " & Cells(r, rg.Column).Address(False, False)
              End If
            End If
          Next
          Set rg = .Cells.Find("Инвентарный номер", rg, xlValues, xlPart)
          If rg Is Nothing Then Exit Do
          If rg.Address = adr Then Exit Do
        Loop
      End If
    End With
  Next
End Sub

и присмотритесь к подписи...

работает! спасибо!
а можно немного попривередничать? )
можно ли перед тем, как инвернарники начнут сверяться:
1) заменить все "O" и "О" на "0", а затем "0414" на "414"
2) убрать любые символы перед "414"
3)убрать ".", "*" и " " (пробелы)
это главное, а остальное уже, по возможности:
4) убрать любые символы перед "б/н"
5) и в последним убрать все символы после цифр инвентарника, допустив только одну букву (абвгджзиклмнрц) после инв.номера, без учета регистра.

[IgorGO]

все можно...

речь идет только о данных содержащих инвентарные номера?

важный вопрос: после исправление инвентарных номеров файлы сохранить?

уточните правила приведения номера к стандартному виду. попытайтесь правила написать четко и однозначно (Вы правильно начали):
понятно что говорим о инвентарных номерах
1. если есть б/н - оставить только б/н
2. удалить ЛЮБЫЕ не цифры в начале
3. заменить ".* " (точка звездочка пробел) на пусто
4. если в конце после цифр есть 1 буква и это (абвгджзиклмнрц) - она остается, остальные хвосты рубаются

продолжайте... (если есть еще что сказать)

[YustasRighno]

Сообщение от IgorGO

все можно...

речь идет только о данных содержащих инвентарные номера?

важный вопрос: после исправление инвентарных номеров файлы сохранить?

уточните правила приведения номера к стандартному виду. попытайтесь правила написать четко и однозначно (Вы правильно начали):
понятно что говорим о инвентарных номерах
1. если есть "б/" или "без номера", "Без номера" - оставить в ячейке только "б/н"
2. удалить ЛЮБЫЕ не цифры в начале
3. заменить ".,;()* " (точка звездочка пробел) на пусто
4. если в конце после цифр есть 1 буква и это (абвгджзиклмнрц) - она остается, остальные хвосты рубаются

продолжайте... (если есть еще что сказать)

после исправление инвентарных номеров файлы НЕ сохранять, а только использовать исправленные номера для дальнейшего сопоставления/сравнения в сводной таблице.

речь идет только о данных содержащих инвентарные номера.

5) если встречается "О" (рус.) или "O" (лат.), заменить на "0" (ноль)
6) после этого если "0" встречается перед "414", тогда удалить "0",
7) если после инвентарного номера встречается "414" еще раз (в некоторых ячейках указано сразу несколько номеров...), тогда анализировать их отдельно... (получится так?) если анализировать несколько номеров из одной ячейки с другими невозможно, тогда поставить "пробел" перед повторяющимся в ячейке "414" (разделить визуально их в ячейке)
8) если есть "нов", заменить содержимое ячейки на "новый"
9) заменить "E+15" на пусто
10) если встречается "Используемая техника" - не анализировать ячейку.

[Hugo121]

По п.7 я уже в начале говорил - убить скобки и Split() им всем...

[YustasRighno]

ну что, получится сделать?