#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:
- Разделите числа на массивы (чтобы мы могли обрабатывать каждое число)
- Добавьте все числа в словарь
AllButUniqueItems
один раз, чтобы он содержал каждое число каждого набора данных один раз. Перенесите все числа, которые уже есть в этом словаре, вDuplicateItems
словарь. - Тогда уникальными элементами будут все элементы, которые есть в,
AllButUniqueItems
но не вDuplicateItems
- Используйте логику (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
исправлен ответ.