сравните значение с ячейками, используя VBA

#excel #vba

#excel #vba

Вопрос:

У меня есть данные (номер) 2 ячейки (Excel) в виде ячейки.

Рис.

Я хочу сравнить между Data1 и Data2 каждое число. если найдены отличительные данные, переместитесь в столбец различий (новая ячейка), а если найдены те же данные, переместитесь в тот же столбец (новая ячейка). наконец, переместите разницу данных и то же самое в difference тот же столбец.

 Data1 = ,4016,4053,6008,6009,6010,6011,24016,24022,24029,24035,24041,24045,24053,24059,24071,24077,24214,24240,24258,24262,24268,26000,26001,26002,26003,26004,26005,26006,26007


Data2 = ,4001,6008,6009,6010,6011,24001,24030,24036,24042,24046,24049,24054,24060,24072,24078,24215,24241,24259,24263,24269,26000,26001,26002,26003,26004,26005,26006,26007
  

Ответ №1:

  1. Разделите числа на массивы (чтобы мы могли обрабатывать каждое число)
  2. Добавьте все числа в словарь AllButUniqueItems один раз, чтобы он содержал каждое число каждого набора данных один раз. Перенесите все числа, которые уже есть в этом словаре, в DuplicateItems словарь.
  3. Тогда уникальными элементами будут все элементы, которые есть в, AllButUniqueItems но не в DuplicateItems
  4. Используйте логику (3), чтобы объединить числа в строки и записать их в ячейки.

введите описание изображения здесь

В итоге получается что-то вроде

 Option Explicit

Public Sub DifferentOrSame()
    'read and split data sets into array
    Dim DataSet1 As Variant
    DataSet1 = Split(ThisWorkbook.Worksheets("data").Range("A2").Value, ",")

    Dim DataSet2 As Variant
    DataSet2 = Split(ThisWorkbook.Worksheets("data").Range("B2").Value, ",")

    Dim AllButUniqueItems As Object
    Set AllButUniqueItems = CreateObject("Scripting.Dictionary")

    Dim DuplicateItems As Object
    Set DuplicateItems = CreateObject("Scripting.Dictionary")

    Dim itm As Variant
    'process data set 1
    For Each itm In DataSet1
        If AllButUniqueItems.Exists(itm) Then
            If Not DuplicateItems.Exists(itm) Then
                DuplicateItems.Add itm, 1
            End If
        Else
            AllButUniqueItems.Add itm, 1
        End If
    Next itm

    'process data set 2
    For Each itm In DataSet2
        If AllButUniqueItems.Exists(itm) Then
            If Not DuplicateItems.Exists(itm) Then
                DuplicateItems.Add itm, 1
            End If
        Else
             AllButUniqueItems.Add itm, 1
        End If
    Next itm

    'concatenate strings
    Dim StrDuplicates As String, StrUniques As String, StrAllButUnique As String
    For Each itm In AllButUniqueItems 
        StrAllButUnique = StrAllButUnique amp; IIf(StrAllButUnique <> vbNullString, ",", "") amp; itm

        If Not DuplicateItems.Exists(itm) Then
            StrUniques = StrUniques amp; IIf(StrUniques <> vbNullString, ",", "") amp; itm
        Else
            StrDuplicates = StrDuplicates amp; IIf(StrDuplicates <> vbNullString, ",", "") amp; itm
        End If
    Next itm

    'write to cells
    ThisWorkbook.Worksheets("data").Range("C2").Value = "'" amp; StrDuplicates
    ThisWorkbook.Worksheets("data").Range("D2").Value = "'" amp; StrUniques
    ThisWorkbook.Worksheets("data").Range("E2").Value = "'" amp; StrAllButUnique
End Sub
  

Комментарии:

1. Спасибо за ваш ответ. Я пробовал, это показывает ошибку. For Each itm In UniqueItems Значение в UniqueItems = Пустое

2. Значение в UniqueItems = Пустое

3. Я поместил данные в A2 и B3, как вы предлагаете.

4. @Mr.Chat моя ошибка, должно быть For Each itm In AllButUniqueItems исправлен ответ.