Удаление повторяющихся строк / Microsoft Office

ReSQL.ru

Мобильная версия Контакт Правила FAQ Помощь

Гость

Войти | Регистрация | Профиль | Очистить

Новые сообщения | Избранное

Форумы | Пользователи | Статистика | Мод. лог | Поиск

Цитировать

Написать

Автор*:

Ввести пароль для входа

Тема*:

Сообщение

Данное сообщение тематическое

Сообщение содержит картинки или видео 18+

Автор:

ВНИМАНИЕ! На данном подфоруме действуют строгие правила. Удостоверьтесь, что ваше сообщение соответствует им!

Форум или тема закрыты для гостей. Необходима авторизация!

Загрузить последнюю сохраненную версию

Вложение:

Вставить как галерею

Максимальный размер вложений: 4,0 МБ, аудио/видео: 8,0 МБ. Картинки большего размера ужимаются, если возможно.

Введите код, изображенный на картинке. Если код нечитаемый, кликните картинку, чтобы загрузить другой вариант.

Отправляя сообщение, я выражаю свое согласие с правилами форума и принимаю пользовательское соглашение.

Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Удаление повторяющихся строк

7 сообщений из 32, страница 2 из 2

все

Удаление повторяющихся строк

#37429174

SirFisher

Гость

PlanBпросто sql-запрос книги excel к самой себе. такое можно встроенными способами сделать ручками. просто в данном случае вам дали красивый и универсальный код

Ручками много чего можно делать, но все упирается в такой фактор как время и производное от времени - скорость. Кроме того, код, предложенный Дмитрием, позволил мне взшлянуть на автоматизацию рутинных процессов с новой точки бытия

...

Рейтинг:

0 / 0

07.09.2011, 15:10

| Ответить | Цитировать | Написать

Удаление повторяющихся строк

#37429269

PlanB

Участник

Откуда: Moscow

Сообщения: 2 731

Рейтинг: 0 / 0

SirFisherDjon PlayerРаз у вас 150 тысяч строк, значит у вас как минимум Excel 2007.
А в Excel 2007 есть такая фишка "Удалить дубликаты" во вкладке "Данные".
Спасибо, мне знакома эта операция в excel. Но она не выполняет задачу в той форме, которая мне нужна. Но, за участие в беседе - спасиборешает...

вообще, как мне кажется, прописывать подключение ADO в задачке, для которой есть, как минимум 2 встроенных метода 2007 excel (я имею ввиду уже упомянутые "удалить дубликаты" и "получить внешние данные из excel"), - дело не благодарное.

...

Рейтинг:

0 / 0

07.09.2011, 15:41

| Ответить | Цитировать | Написать

Удаление повторяющихся строк

#37429412

kuklp

Гость

SirFisher,
Попробуйте из кода Дмитрия убрать кейс, т.е. строки

Код: plaintext

1.
2.
3.
4.
5.
6.
7.

Select Case CLng(Split(Application.Version, ".")( 0 ))
    Case Is <  12 
        sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FilePath _
          & ";Extended Properties=""Excel 8.0;HDR=" & FieldName & ";IMEX=1"";"
    Case Is >=  12 
        sCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FilePath _
        & ";Extended Properties=""Excel 12.0;HDR=" & FieldName & ";IMEX=1"";"
End Select

заменить на

Код: plaintext

        sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FilePath _
          & ";Extended Properties=""Excel 8.0;HDR=" & FieldName & ";IMEX=1"";"

Должно работать быстрей.

...

Рейтинг:

0 / 0

07.09.2011, 16:42

| Ответить | Цитировать | Написать

Удаление повторяющихся строк

#37438748

Hugo121

Гость

Более чем в 2 раза быстрее получилось:

Sub test2()
Dim tm: tm = Timer
Sheets(2).[A1].CurrentRegion.ClearContents

Dim a(), oDict As Object, i As Long, temp As String
Dim ind As Long
With Sheets(1)
a = .[A1].CurrentRegion.Value
End With

ReDim b(1 To UBound(a), 1 To 22)

Set oDict = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(a)
temp = _
a(i, 3) & "|" & _
a(i, 4) & "|" & _
a(i, 5) & "|" & _
a(i, 6) & "|" & _
a(i, 7) & "|" & _
a(i, 8) & "|" & _
a(i, 9) & "|" & _
a(i, 10) & "|" & _
a(i, 11) & "|" & _
a(i, 12) & "|" & _
a(i, 13) & "|" & _
a(i, 14) & "|" & _
a(i, 15) & "|" & _
a(i, 16) & "|" & _
a(i, 17) & "|" & _
a(i, 18) & "|" & _
a(i, 19) & "|" & _
a(i, 20) & "|" & _
a(i, 21) & "|" & _
a(i, 22)
If Not oDict.Exists(temp) Then
ind = ind + 1
oDict.Add temp, CStr(ind)
For ii = 1 To 22: b(ind, ii) = a(i, ii): Next
End If
Next

With Sheets(2)
.[A1].Resize(ind, 22) = b
End With

Sheets(2).Activate
Debug.Print Timer - tm
End Sub

...

Рейтинг:

0 / 0

13.09.2011, 18:23

| Ответить | Цитировать | Написать

Удаление повторяющихся строк

#37438751

Hugo121

Гость

Упс, упустил:

For i = UBound(a) To 1 Step -1

но тогда ещё в конце отсортировать по порядку.

...

Рейтинг:

0 / 0

13.09.2011, 18:25

| Ответить | Цитировать | Написать

Удаление повторяющихся строк

#37439355

Hugo121

Гость

Предыдущий вариант просто оставляет первую попавшуюся уникальную строку (в зависимости от направления перебора массива это будет первая или последняя строка источника).
Вот ещё два варианта - первый оставляет последнюю строку из дублей (т.е. практически как v.01), второй оставляет строку с последней датой (еcли даты одинаковы, тогда последнюю встреченную).
Но вывод не сортируется.
Вообще на ADO результат красивее - сортированный, и отбор последних по бОльшему количеству полей задан, но процесс в 2 раза медленнее на примере (не знаю, как на 150к строк будет), но сложнее настройка, да и может хватит просто взять строку с последней датой?

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.

Sub test3() 'оставляет последнюю строку из дублей
'Dim tm: tm = Timer
 Sheets( 2 ).[A1].CurrentRegion.ClearContents

    Dim a(), oDict As Object, i As Long, ii As Long, temp As String
    Dim ind As Long
    With Sheets( 1 )
        a = .[A1].CurrentRegion.Value
    End With

    ReDim b( 1  To UBound(a),  1  To  22 )

    Set oDict = CreateObject("Scripting.Dictionary")

    For i =  1  To UBound(a)
        temp = _
        a(i,  3 ) & "|" & _
        a(i,  4 ) & "|" & _
        a(i,  5 ) & "|" & _
        a(i,  6 ) & "|" & _
        a(i,  7 ) & "|" & _
        a(i,  8 ) & "|" & _
        a(i,  9 ) & "|" & _
        a(i,  10 ) & "|" & _
        a(i,  11 ) & "|" & _
        a(i,  12 ) & "|" & _
        a(i,  13 ) & "|" & _
        a(i,  14 ) & "|" & _
        a(i,  15 ) & "|" & _
        a(i,  16 ) & "|" & _
        a(i,  17 ) & "|" & _
        a(i,  18 ) & "|" & _
        a(i,  19 ) & "|" & _
        a(i,  20 ) & "|" & _
        a(i,  21 ) & "|" & _
        a(i,  22 )
        If Not oDict.Exists(temp) Then
            ind = ind +  1 
            oDict.Add temp, CStr(ind)
            For ii =  1  To  22 : b(ind, ii) = a(i, ii): Next
        Else
            ii = oDict.Item(temp)
            b(ii,  1 ) = a(i,  1 ): b(ii,  2 ) = a(i,  2 )
        End If
    Next

    With Sheets( 2 )
        .[A1].Resize(ind,  22 ) = b
    End With

Sheets( 2 ).Activate
'Debug.Print Timer - tm
End Sub


Sub test4() 'оставляет последнюю дату
'Dim tm: tm = Timer
 Sheets( 2 ).[A1].CurrentRegion.ClearContents

    Dim a(), oDict As Object, i As Long, ii As Long, temp As String
    Dim ind As Long
    With Sheets( 1 )
        a = .[A1].CurrentRegion.Value
    End With

    ReDim b( 1  To UBound(a),  1  To  22 )

    Set oDict = CreateObject("Scripting.Dictionary")

    For i =  1  To UBound(a)
        temp = _
        a(i,  3 ) & "|" & _
        a(i,  4 ) & "|" & _
        a(i,  5 ) & "|" & _
        a(i,  6 ) & "|" & _
        a(i,  7 ) & "|" & _
        a(i,  8 ) & "|" & _
        a(i,  9 ) & "|" & _
        a(i,  10 ) & "|" & _
        a(i,  11 ) & "|" & _
        a(i,  12 ) & "|" & _
        a(i,  13 ) & "|" & _
        a(i,  14 ) & "|" & _
        a(i,  15 ) & "|" & _
        a(i,  16 ) & "|" & _
        a(i,  17 ) & "|" & _
        a(i,  18 ) & "|" & _
        a(i,  19 ) & "|" & _
        a(i,  20 ) & "|" & _
        a(i,  21 ) & "|" & _
        a(i,  22 )
        If Not oDict.Exists(temp) Then
            ind = ind +  1 
            oDict.Add temp, CStr(ind)
            For ii =  1  To  22 : b(ind, ii) = a(i, ii): Next
        Else
            ii = oDict.Item(temp)
            If CDate(b(ii,  3 )) <= CDate(a(i,  3 )) Then _
            b(ii,  1 ) = a(i,  1 ): b(ii,  2 ) = a(i,  2 ): b(ii,  3 ) = a(i,  3 )
        End If
    Next

    With Sheets( 2 )
        .[A1].Resize(ind,  22 ) = b
    End With

Sheets( 2 ).Activate
'Debug.Print Timer - tm
End Sub

...

Рейтинг:

0 / 0

14.09.2011, 09:12

| Ответить | Цитировать | Написать

Удаление повторяющихся строк

#37448442

Ivan33

Участник

Откуда: Оттуда! А куда? Туда!

Сообщения: 948

Рейтинг: 0 / 0

Коллеги, подскажите по коду (см. ниже). Взят из примера выше (в начеле темы).

Работает относительно первой строки. Как сдвинуть относительно второй второй строки (то есть будет заголовок и одна строка с которой не будет производиться работа). Другими словами, первый две строки не трогать.

Менял вот это

Код: plaintext

With Range("BQ2:BQ" & cntRows)

на

Код: plaintext

With Range("BQ3:BQ" & cntRows)

Ниже в

Код: plaintext

x = Cells(r,  69 ).Value: On Error Resume Next
        Set Rng = Range(Cells( 1 ,  69 ), Cells(r -  1 ,  69 )).Find(What:=x, LookAt:=xlWhole)

перепробовал комбинации заставить работать как надо не удалось.

Основной код:

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.

cntRows = WorksheetFunction.CountA(Columns( 1 ))

    With Range("BQ2:BQ" & cntRows)
        .FormulaR1C1 = _
            "=RC[-41]"
            
        .Copy
        .PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End With
    
    For r = cntRows To  1  Step - 1 
        r_percent = Round( 100  - r *  100  / cntRows,  2 )
        Application.StatusBar = "Îáðàáîòàíî " & cntRows - r & " èç " & cntRows & " ñòðîê (" & r_percent & "%)"
            
        x = Cells(r,  69 ).Value: On Error Resume Next
        Set Rng = Range(Cells( 1 ,  69 ), Cells(r -  1 ,  69 )).Find(What:=x, LookAt:=xlWhole)
        If Not Rng Is Nothing Then
               MsgBox "Äóáëèðîâàíèå îñíîâíîãî øòðèõ-êîäà! Çàïèñü áóäåò óäàëåíà!"
               RngAddress = Rng.Address
               Range(RngAddress).EntireRow.Delete
               Exit Sub
            
        End If
    Next r
    
    Columns( 69 ).Clear

...

Рейтинг:

0 / 0

20.09.2011, 16:57

| Ответить | Цитировать | Написать

7 сообщений из 32, страница 2 из 2

все

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Удаление повторяющихся строк

Читали тему (0):

Читали форум (0):

Пользователи онлайн (0):

start [/forum/topic.php?fid=61&msg=37448442&tid=2176482]:	0ms
get settings:	4ms
get forum list:	16ms
check forum access:	2ms
check topic access:	2ms
track hit:	132ms
get topic data:	9ms
get forum data:	2ms
get page messages:	43ms
get tp. blocked users:	1ms
others:	219ms

total:	430ms

	Необходимые cookie
	Cookie для сбора статистики
	Cookie для маркетинга и рекламы