помогите, пожалуйста, решить следующую excel-головоломку. Есть следующая таблица. Рис1.http://prntscr.com/kqijmk
Мне нужно удалить все строки, в которых есть ячейки-дубликаты в столбце Фраза (они же имеют одинаковую заливку). На скрине пример выделен красным. А также перенести столбцы URL2 ... URL10 в столбик как на примере в приложении.
В приложении - файл. Закладка До - что нужно переделать. Закладка После - как должно быть на выходе.
riva3, в следующий раз показывайте не два файла, а файл с двумя листами: 1 - исходные данные и 2 - желаемый результат: помогающим не нужно будет скачивать две книги, да и для работы так удобнее.
Sub test()
Dim dic As Object, txt$, ikey, iarr$()
Dim arr(), i&, j&, i_dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Set i_dic = CreateObject("Scripting.Dictionary")
arr = Worksheets("До").UsedRange.Value
For i = 2 To UBound(arr)
If Not IsEmpty(arr(i, 1)) Then
For j = 2 To UBound(arr, 2)
txt = arr(i, 1) & "|" & arr(i, j)
dic.Item(txt) = 0
Next j
End If
Next i
For Each ikey In dic.keys
iarr = Split(ikey, "|")
i_dic.Item(iarr(0)) = i_dic.Item(iarr(0)) & iarr(1) & "|"
Next ikey
Worksheets("После").Cells.Clear
For Each ikey In i_dic.keys
With Worksheets("После")
.[a1].Resize(, 2) = Array("Фраза", "URL [Google]")
i = .Range("b" & .Rows.Count).End(xlUp).Row + 1
iarr = Split(i_dic.Item(ikey), "|")
.Range("a" & i).Value = ikey
.Range("b" & i).Resize(UBound(iarr)).Value = Application.Transpose(iarr)
End With
Next ikey
End Sub
"Все гениальное просто, а все простое гениально!!!"