Доброго дня! Тем про уникальные значения много, но конкретно решения такой задачи я найти не смог! Итак, у нас 3 таблицы("Б1", "Б2", "Уникальные"), нужно из таблиц "Б1" и "Б2" вытянуть уникальные значения и закинуть их в "Уникальные" Если формулами это нереально, то может макросом?
Доброго дня! Тем про уникальные значения много, но конкретно решения такой задачи я найти не смог! Итак, у нас 3 таблицы("Б1", "Б2", "Уникальные"), нужно из таблиц "Б1" и "Б2" вытянуть уникальные значения и закинуть их в "Уникальные" Если формулами это нереально, то может макросом?lFJl
lFJl, добрый день,протестируйте макрос,кнопка test
[vba]
Код
Sub test() Dim z(), i&, m& z = Range("A2:D" & Range("A" & Rows.Count).End(xlUp).Row).Value With CreateObject("scripting.dictionary"): .CompareMode = 1 For i = 1 To UBound(z) If .exists(z(i, 1)) = False Then m = m + 1: .Item(z(i, 1)) = m: z(m, 1) = z(i, 1) Else z(.Item(z(i, 1)), 1) = z(i, 1) End If Next For i = 1 To UBound(z) If .exists(z(i, 4)) = False Then m = m + 1: .Item(z(i, 4)) = m: z(m, 1) = z(i, 4) Else z(.Item(z(i, 4)), 1) = z(i, 4) End If Next Range("G2").Resize(.Count, 1).Value = z End With End Sub
[/vba]
lFJl, добрый день,протестируйте макрос,кнопка test
[vba]
Код
Sub test() Dim z(), i&, m& z = Range("A2:D" & Range("A" & Rows.Count).End(xlUp).Row).Value With CreateObject("scripting.dictionary"): .CompareMode = 1 For i = 1 To UBound(z) If .exists(z(i, 1)) = False Then m = m + 1: .Item(z(i, 1)) = m: z(m, 1) = z(i, 1) Else z(.Item(z(i, 1)), 1) = z(i, 1) End If Next For i = 1 To UBound(z) If .exists(z(i, 4)) = False Then m = m + 1: .Item(z(i, 4)) = m: z(m, 1) = z(i, 4) Else z(.Item(z(i, 4)), 1) = z(i, 4) End If Next Range("G2").Resize(.Count, 1).Value = z End With End Sub
Sub d() Dim dic As Object, m1, m2 Set dic = CreateObject("scripting.dictionary") m1 = [a2:a30].Value: m2 = [d2:d30].Value On Error Resume Next For i = 1 To UBound(m1) dic.Add (m1(i, 1)), i Next
For i = 1 To UBound(m2) dic.Add (m2(i, 1)), i Next m1 = dic.keys ReDim m2(0 To UBound(m1), 1 To 1) For i = 0 To UBound(m2): m2(i, 1) = m1(i): Next [g2].Resize(UBound(m2) + 1, 1) = m2 End Sub
[/vba]
Вот макрос для примера: [vba]
Код
Sub d() Dim dic As Object, m1, m2 Set dic = CreateObject("scripting.dictionary") m1 = [a2:a30].Value: m2 = [d2:d30].Value On Error Resume Next For i = 1 To UBound(m1) dic.Add (m1(i, 1)), i Next
For i = 1 To UBound(m2) dic.Add (m2(i, 1)), i Next m1 = dic.keys ReDim m2(0 To UBound(m1), 1 To 1) For i = 0 To UBound(m2): m2(i, 1) = m1(i): Next [g2].Resize(UBound(m2) + 1, 1) = m2 End Sub
lFJl, вариант макроса с двумя массивами(предыдущий мой вариант с одним массивом).
[vba]
Код
Sub test1() Dim z, z1, i&, m& z = Range("A2:D" & Range("A" & Rows.Count).End(xlUp).Row).Value ReDim z1(1 To UBound(z) * 2, 1 To 1) With CreateObject("scripting.dictionary"): .CompareMode = 1 For i = 1 To UBound(z) If .exists(z(i, 1)) = False Then m = m + 1: .Item(z(i, 1)) = m: z1(m, 1) = z(i, 1) Else z1(.Item(z(i, 1)), 1) = z(i, 1) End If Next For i = 1 To UBound(z) If .exists(z(i, 4)) = False Then m = m + 1: .Item(z(i, 4)) = m: z1(m, 1) = z(i, 4) Else z1(.Item(z(i, 4)), 1) = z(i, 4) End If Next Range("H2").Resize(.Count, 1).Value = z1 End With End Sub
[/vba]
lFJl, вариант макроса с двумя массивами(предыдущий мой вариант с одним массивом).
[vba]
Код
Sub test1() Dim z, z1, i&, m& z = Range("A2:D" & Range("A" & Rows.Count).End(xlUp).Row).Value ReDim z1(1 To UBound(z) * 2, 1 To 1) With CreateObject("scripting.dictionary"): .CompareMode = 1 For i = 1 To UBound(z) If .exists(z(i, 1)) = False Then m = m + 1: .Item(z(i, 1)) = m: z1(m, 1) = z(i, 1) Else z1(.Item(z(i, 1)), 1) = z(i, 1) End If Next For i = 1 To UBound(z) If .exists(z(i, 4)) = False Then m = m + 1: .Item(z(i, 4)) = m: z1(m, 1) = z(i, 4) Else z1(.Item(z(i, 4)), 1) = z(i, 4) End If Next Range("H2").Resize(.Count, 1).Value = z1 End With End Sub
akobir, sv2014, SLAVICK, jakim, _Boroda_, Спасибо вам! Буду разбираться! У меня будут значения не только числовые но и буквенно-числовые, не все формулы справляются почему-то. С сортировкой кстати тоже здорово было бы! Сори, что сразу этого не написал, не знал что можно и так и так. [moder]Ну так приведите РЕАЛЬНЫЙ пример. 100 с лишним сообщений уже, а все как первый раз. Безобразие!!!
akobir, sv2014, SLAVICK, jakim, _Boroda_, Спасибо вам! Буду разбираться! У меня будут значения не только числовые но и буквенно-числовые, не все формулы справляются почему-то. С сортировкой кстати тоже здорово было бы! Сори, что сразу этого не написал, не знал что можно и так и так. [moder]Ну так приведите РЕАЛЬНЫЙ пример. 100 с лишним сообщений уже, а все как первый раз. Безобразие!!!lFJl
Сообщение отредактировал _Boroda_ - Четверг, 31.03.2016, 07:39