Команда RemoveDuplicates, вызывающая ошибку 1004 во время выполнения в общей книге (работает в неразделенном) - PullRequest
Новая
       65

Команда RemoveDuplicates, вызывающая ошибку 1004 во время выполнения в общей книге (работает в неразделенном)

1 голос
/ 10 апреля 2020

Я получаю ошибку 1004 во время выполнения в строке .RemoveDuplicates в следующем коде инициализации пользовательской формы, когда книга запускается в режиме совместного использования. Эта ошибка не возникает, когда книга запускается в «необщем» режиме: 

Private Sub UserForm_Initialize()
    Dim ContactList As Range, DedupedOrganizationList As Range
    Set ContactList = Sheets("Lists").Range("Contacts")
    Me.cbxContact.Text = ActiveCell
    Me.cbxEmail.Text = ActiveCell.Offset(0, 1).Value
    With Sheets("Lists")
        .Range("I2:K100000").ClearContents
        .Range("K1").Value = "Unique Company List"
        .Range("I2:K" & ContactList.Rows.Count) = ContactList.Value
        .Range("I:J").ClearContents
        .Range("K1:K" & ContactList.Rows.Count).RemoveDuplicates Columns:=1, Header:=xlYes
    End With
    Me.cbxOrganization.RowSource = "DedupedOrganization"
    Me.cbxOrganization.Text = ActiveCell.Offset(0, 3).Value
    Run CheckActiveScreen(Me)
End Sub

Когда строка RemoveDuplicates закомментирована, код работает без проблем в режиме совместного использования.

I ' Я читал, что защита листа создала проблемы для людей в этом отношении, но я не могу найти никакой информации (или здесь) о том, как справиться с «общей» проблемой.

Моя цель - заполнить поле со списком дедуплицированных компаний. Компании могут дублироваться в моем Contacts именованном диапазоне, поэтому я не могу использовать этот диапазон в качестве источника для раскрывающегося списка. Мое решение состояло в том, чтобы переместить список в другой столбец, дедуплировать его и установить его в качестве источника строки комбинированного списка.

Я думаю, я мог бы заполнить массив или словарь и дедуплировать это (без использования команды RemoveDuplicates) , но встроенную команду очень легко реализовать ... если есть простая настройка, чтобы заставить ее работать в режиме совместного использования, я бы сначала попробовал.

Если использовать невозможно команда RemoveDuplicates в режиме совместного использования, пожалуйста, дайте мне подсказку, как я могу дедуплицировать переменную массива или словарь и использовать результат, чтобы заполнить мой источник строки комбобокса этим списком.

Есть ли альтернативная функция? для дедупликации списка (обходной путь для сбойных RemoveDuplicates)?

====================================== ===================

Обновление ... это сработало: 

Private Sub UserForm_Initialize()
    Dim ContactList As Range, DedupedOrganizationList As Range
    Set ContactList = Sheets("Lists").Range("Contacts")
    Me.cbxContact.Text = ActiveCell
    Me.cbxEmail.Text = ActiveCell.Offset(0, 1).Value
    With Sheets("Lists")
        .Range("I2:K100000").ClearContents
        .Range("K1").Value = "Organization"
        .Range("I2:K" & ContactList.Rows.Count) = ContactList.Value
        .Range("I:J").ClearContents
        Run ShareFriendlyRemoveDuplicates
    End With
    Me.cbxOrganization.RowSource = "DedupedOrganization"
    Me.cbxOrganization.Text = ActiveCell.Offset(0, 3).Value
    Run CheckActiveScreen(Me)
End Sub


Function ShareFriendlyRemoveDuplicates()
    Dim dict As Object, rowCount As Long, strVal As String, lastRow As Long
    Set dict = CreateObject("Scripting.Dictionary")
    rowCount = Sheets("Lists").Range("K100000").End(xlUp).Row
    lastRow = rowCount
    Do While rowCount > 1
      strVal = Sheets("Lists").Cells(rowCount, 11).Value2
      If dict.exists(strVal) Then
        Sheets("Lists").Cells(rowCount, 11).ClearContents
      Else
        dict.Add strVal, 0
      End If
      rowCount = rowCount - 1
    Loop
    Set dict = Nothing
   'sort to close gaps
    Sheets("Lists").Range("K2:K" & lastRow).Sort Key1:=Sheets("Lists").Range("K2"), Order1:=xlAscending, Header:=xlYes
End Function
...