[@refregirator]

Добрый день. Пытаюсь сделать код, который бы выводил мне данные о задвоении номеров документов, и выводил информацию в каких подшивках есть такие повторяющиеся документы.
Оговорюсь, что в этом деле новичек, но уже понял, что в этом деле надо разобраться, ибо на новой работе мне это еще пригодится.
Итак, мне помогли, и на текущий момент получается вот такой код:
но
1) Нужно ли использовать два словаря в данном случае? может есть более оптимальный способ?
2) Данный код работает не так как надо, он выводит мне в столбец X все подшивки с повторами, а нужны только те, в которых повторяется именно тот документ которому соответствует данная строка, подскажите где мой косяк?
3)Мне кажется не очень изящным подход, где первое задвоение я ставлю уже при заполнении строки вот здесь:
Range(h2(c.Value)).Offset(, 15) = Range(h2(c.Value)).Offset(, 10) & hKey или норм?
4)h(c.Value) = c.Address - в этой строке не могу ни на что поменять c.adrress (например на value) выдает ошибку range method почему только адресс воспринимает?
5)sTmp = c.Offset(0, 10).Value ' Почему Range(h(c.Value)).Offset(, 10) выдает 1 значение? Ведь по for each c должно быть уникальное значение
6)Еще буду благодарен за подсказку в следующем, думаю над улучшением кода, и в частности есть такая ситуация, что документ может повторится случайно у двух разных подрядчиков, то есть по факту это не повтор. Как можно отсеять такие совпадения?, то есть проверять повтор только в рамках одного подрядчика (задается номером договора).

Не прошу готового решения (хотя буду благодарен если покажется не сложным) прошу подсказать (примерно как первокласснику).

PureBasic

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 Sub getTheSame3()     Dim sAlarma1 As String       sAlarma1 = "Внимание! Макрос проверит повторы в столбце I, и заполнит X столбец значениями из S. " _     & "Действия выполненные макросом невозможно отменить."         If MsgBox(sAlarma1, vbOKCancel) = vbCancel Then             Exit Sub         Else:     Dim rg1 As Range     On Error Resume Next             Set rg1 = Columns(24).Cells.SpecialCells(xlCellTypeConstants, xlNumbers)             For Each c In rg1.Cells                 rg1.ClearContents             Next c         '==============================        On Error GoTo errh:    'Устанавливаем хендлер ошибок         Dim h As New Scripting.dictionary    'Создаем хеш - множество пар "ключ" -> значение        Dim hKey        Dim hItem        Dim rg As Range        Dim sTmp As String        Set rg = Columns(9).Cells.SpecialCells(xlCellTypeConstants)    'Берем только константы из колонки 9 ' В первом заходе создаем строковую переменную        For Each c In rg.Cells    'Перебираем все ячейки из множества             If h.Exists(c.Value) Then  'Если ключ существует                sTmp = c.Offset(0, 10).Value                hKey = hKey & " " & sTmp            Else                h(c.Value) = c.Address ' Почему при попытке изменить выдает ошибку Method range failed             End If         Next c ' Во втором заходе проставляем эту переменную        Dim h2 As New Scripting.dictionary        For Each c In rg.Cells            If h2.Exists(c.Value) Then                c.Offset(0, 15).Value = Range(h2(c.Value)).Offset(, 10) & hKey                Range(h2(c.Value)).Offset(, 15) = Range(h2(c.Value)).Offset(, 10) & hKey                        Else                h2(c.Value) = c.Address            End If        Next c    Set h = Nothing    Set h2 = Nothing 'Освобождаем память из под хеша     MsgBox "Done", vbInformation         End If On Error GoTo 0 Exit Sub '============================= errh:        'В обычных условиях if 0 никогда не сработает     Set h = Nothing    'Если возникла ошибка - освобождаем память из под хеша    MsgBox Err.Description    'Выводим сообщение об ошибке '============================= End Sub

[@refregirator]

Сейчас разберусь почему ошибка при добавлении файла и добавлю файл с примером.

[@refregirator]

я совсем че-то не так делаю со своим вопросом?)

[toiai]

Попробуй такой вариант:

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 Sub getTheSame4()       Dim i&, k     Dim rg As Range     Set rg = Range("I6:I" & Range("i" & Rows.Count).End(xlUp).Row)     a = rg     With CreateObject("Scripting.dictionary")         For i = 1 To UBound(a, 1)             If .Exists(a(i, 1)) Then 'Если ключ существует                .Item(a(i, 1)) = .Item(a(i, 1)) & " " & i             Else                 .Item(a(i, 1)) = ""             End If         Next i         For Each k In .Items             If k <> "" Then                 s = Split(Application.Trim(k))                 For i = 0 To UBound(s)                     rg.Cells(Val(s(i))).Interior.Color = vbYellow                 Next             End If         Next     End With End Sub

[@refregirator]

Вы убрали вывод данных в ячейки, а заменили на выделение цветом? в данном случае получается проблема, которая у меня была изначально, цветом выделяются повторы, а само первое значение, не считается повтором и не выделяется, хотя им является.
Правильно я понимаю, что в данном случае это первое значение значение является .key соответственно надо как-то проверить есть ли .item для .key, и если есть его тоже пометить как повтор, так?

[toiai]

Ну тогда немного коррекции и:

Visual Basic

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Sub getTheSame5()     Dim i&, k     Dim rg As Range     Set rg = Range("I6:I" & Range("i" & Rows.Count).End(xlUp).Row)     a = rg     With CreateObject("Scripting.dictionary")         For i = 1 To UBound(a, 1)             .Item(a(i, 1)) = .Item(a(i, 1)) & " " & i         Next i         For Each k In .Items             If k <> "" Then                 s = Split(Application.Trim(k))                 If UBound(s) <> 0 Then                     For i = 0 To UBound(s)                         rg.Cells(Val(s(i))).Interior.Color = vbYellow                     Next                 End If             End If         Next     End With End Sub

[@refregirator]

Вроде даже короче стало) теперь выделилось все. Попробую добавить часть с выводом значений через offset, спасибо.