Сортировка, сравнение, объединение, удаление

@alexcrz · Регистрация: 26.03.2013

Author24 — интернет-сервис помощи студентам

Здравствуйте.

Дана таблица из 9 столбцов

1. Сортируем по 5 столбцу
2. Сравниваем ячейки 5 столбца, если две ячейки совпадают
3. то объединяем ячейки 3 столбца через ","
4. удаляем одну строку, чтобы не было дублей

В первую очередь прошу ссылки "куда читать" для экономии времени. Алгоритм мне понятен, но синтаксиса не знаю вообще. Вчера начал изучать VBA. Надо к понедельнику разобраться, как решать такие задачи, и где есть читабельные справочник/кукбук.

Добавлено через 2 минуты
да, все ячейки текстовые

Добавлено через 8 минут
1 ..... a2 ..... qwert ..... ..... ..... .....
2 ..... b5 ..... qwert ..... ..... ..... .....
3 ..... j2 ..... zwqw ..... ..... ..... .....

получаем

1 ..... a2, b5 ..... qwert ..... ..... ..... .....
3 ..... j2 ..... zwqw ..... ..... ..... .....

Добавлено через 9 минут
еще цикл получаем с первой строки до последней минус один - количество строк произвольно

@Казанский · 14.03.2019, 10:54

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

@Hugo121 · 14.03.2019, 11:06

Сообщение от alexcrz

удаляем одну строку

- т.к. Вы новичёк, сразу подскажу что для этого правильнее циклом идти снизу вверх.
Если строки удалять не сразу все, а по одной.

@alexcrz · 14.03.2019, 11:23 **[ТС]**

в чём разница?

по одной, так как надо значение 3-ого столбца из удаляемой строки забирать. Забрали - удалили. Может 3-10 строк одинаковых. Получим

1 ..... a2, b5, a3, a6, b99, c7, c4 ..... qwert ..... ..... ..... .....

кстати, надо добавлять повторную проверку изменённой строки со следующей после удалённой!

Добавлено через 5 минут
Hugo121, я понял, спасибо!

@Ухин Николай · 14.03.2019, 16:19

Немного не в тему, но всё-же.
Код моего макроса, сканирует ячейки столбца на наличие номеров телефонов
Пример исходной страницы:

+7-900-000-00-01 000001
+7-900-000-00-02 000002
+7-900-000-00-03 000003
+7-900-000-00-04 000004
+7-900-000-00-02 000005
+7-900-000-00-02 000006

После этого записывает в массив в таком виде:

+7-900-000-00-01 000001
+7-900-000-00-02 000001, 000005, 000006
+7-900-000-00-03 000001
+7-900-000-00-04 000001

По идее похоже на твою задачу,
позже попробую переделать под твои условия

Кликните здесь для просмотра всего текста

Visual Basic

Sub Search()
Dim sh As Excel.Worksheet
Dim last As Long
Dim i As Long
Dim k As Long
Dim h As Long
Dim j As Long
Set sh = ActiveWorkbook.Worksheets(1)
last = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
k = 1
ReDim o$(1 To last, 1 To 2)
ReDim r$(1 To 150, 1 To 2)
For i = 1 To UBound(o)
o(i, 1) = sh.Cells(i, 1).text
o(i, 2) = Right(sh.Cells(i, 3).text, 6)
Next i
 
For i = 1 To UBound(o)
j = InStr(1, o(i, 1), "+")
 
Do While j > 0
    For h = k To 1 Step -1
        If r(h, 1) = Mid(o(i, 1), j, 16) Then
            r(h, 2) = r(h, 2) & ", " & o(i, 2)
            Exit For
            Else
            If h = 1 Then
            r(k, 1) = Mid(o(i, 1), j, 16)
            r(k, 2) = o(i, 2)
            k = k + 1
            End If
        End If
        
    Next h
    
j = InStr(j + 1, o(i, 1), "+")
 
Loop
 
Next i
 
'Next i
 
Application.Workbooks.Add.Worksheets(1).Cells(1, 1).Resize(UBound(r), 2).Value = r
End Sub

@alexcrz · 14.03.2019, 16:35 **[ТС]**

мне, на самом деле, всё в тему, что касается 4 пунктов + циклы. Спасибо.

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

@Ухин Николай · 15.03.2019, 09:14

Я сам пока не особо в VBA, но попробуй такой код на каком нибудь подопытном файле.

Visual Basic

Sub Search()
Dim sh As Excel.Worksheet
Dim last As Integer
Dim i As Integer
Dim k As Integer
 
Set sh = ActiveWorkbook.Worksheets(1)
i = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
 
Do While i > 0
    k = i - 1
    Do While k > 0
        If sh.Cells(i, 5) = sh.Cells(k, 5) Then
            sh.Cells(k, 3) = sh.Cells(k, 3) & ", " & sh.Cells(i, 3)
            Rows(i & ":" & i).Delete Shift:=xlUp
            k = k - 2
            i = i - 1
        Else
            k = k - 1
        End If
    Loop
    i = i - 1
Loop
 
MsgBox ("rezult")
 
End Sub

Добавлено через 49 минут
Извиняюсь, требуется немного переделать (значения в ячейки записывает, вот только порядок неверный). Вот новый:

Visual Basic

Sub Search()
Dim sh As Excel.Worksheet
Dim last As Integer
Dim i As Integer
Dim k As Integer
 
Set sh = ActiveWorkbook.Worksheets(1)
i = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
 
Do While i > 0
    k = i - 1
    Do While k > 0
        
        If sh.Cells(i, 5) = sh.Cells(k, 5) Then
            sh.Cells(k, 3) = sh.Cells(k, 3) & ", " & sh.Cells(i, 3)
            sh.Rows(i & ":" & i).Delete Shift:=xlUp
            k = k - 1
        End If
        k = k - 1
    Loop
    i = i - 1
Loop
 
MsgBox ("rezult")
 
End Sub

@alexcrz · 15.03.2019, 10:50 **[ТС]**

я цикл сделал так

Visual Basic

For i= 1 To CountRow
If Cells(LastRow, SortColumn) = Cells(LastRow - 1, SortColumn) Then
Cells(LastRow - 1, SortColumn) = Cells(LastRow - 1, SortColumn) & ", " & Cells(LastRow, SortColumn)
ShAccount.Cell(LastRow, SortColumn).EntireRow.Delete
End If
 
LastRow = LastRow - 1
Next i

Вопрос. При записи рекордером сортировки столбцов получаю строки типа

Visual Basic

1
2
3

Key:=Range("E1:E21")
....
SetRange Range("A3:E21")

Как в Range подставить переменные ряда и столбца?
Или как по-другому определить диапазон ячеек?

Добавлено через 2 минуты
Ухин Николай, по подсказке убрал "Лист1" из ActiveWorkbook.Worksheets(1). Спасибо!

@Hugo121 · 15.03.2019, 11:08

Сообщение от alexcrz

Как в Range подставить переменные ряда и столбца?

Visual Basic

1	Key:=Range("E" & stroka1 & ":E" & stroka2)

С столбцами чуть сложнее (если переменная столбца не буква конечно), тогда проще перейти на обращение Cells(x, y)

@Ухин Николай · 15.03.2019, 14:48

Сообщение от alexcrz

Visual Basic

For i= 1 To CountRow
If Cells(LastRow, SortColumn) = Cells(LastRow - 1, SortColumn) Then
Cells(LastRow - 1, SortColumn) = Cells(LastRow - 1, SortColumn) & ", " & Cells(LastRow, SortColumn)
ShAccount.Cell(LastRow, SortColumn).EntireRow.Delete
End If
LastRow = LastRow - 1
Next i

А твой поиск работает когда между двумя одинаковыми значениями строчка с другим будет?
Он вроде же сравнивает только соседние строки?

Добавлено через 29 минут
Кстати по поводу цикла. Есть возможность перебирать в обратном порядке, от большего к меньшему:

Visual Basic

For i = CountRow to 1 step -1
 
...
 
Next i

@alexcrz · 15.03.2019, 15:51 **[ТС]**

вроде да...
будут разные значения - перейдёт на следующую пару LastRow и LastRow - 1
Будут одинаковые - склеит значения двух ячеек и удалит строку, перейдет на следующую пару

да, с синтаксисом борюсь - спасибо

Добавлено через 8 минут
значения в столбце я отсортировал... пока криво с магическими константами, сегодня доделаю

далее увидел окна на ютубе, куда пользователь может вводить значения перед обработкой
буду мучить ввод "столбцов сортировки", "столбцов объединённых данных", "строки начала таблицы"

на этой основе можно будет проводить модернизацию. Пока без понятия, что за разнообразие выгрузки мне предстоит ставить на конвейер. Хотя макроса с циклом мне сейчас выше крыше под конкретную задачу. Остальное для самообразования.

@Ухин Николай · 15.03.2019, 16:18

Попробуй, вроде норм работает, даже сохраняет значения в 3 столбце в порядке очередности

@Hugo121 · 15.03.2019, 17:44

Для работы и самообразования нужно изучить массивы и словари. И коллекции.

@alexcrz · 16.03.2019, 13:57 **[ТС]**

мысль о сортировке скопилась

a1
a10
a2
a3

тут уже моё невежество в Excel. При этом я понимаю, что может быть и такое

aaaaa1
aaaaa10
aaaaa2

куда посмотреть? я вопрос не могу Гуглу сформулировать. Логически вижу деление на текстовую и числовую часть + сортировка пузырьком

Добавлено через 7 минут
у меня и склеенные ячейки идут без предварительной сортировки

c9, c10, c8, c7

отсортирую до цикла, - будет

c7, c8, c9, c10

Добавлено через 6 минут
думаю надо сперва 3 столбец сортировать,
затем 5,
затем уже склеивать 3

интересен алгоритм сортировки рекодером. При сортировке 5 столбца, 3 столбец перемешан не будет?
пойду читать мануал к параметрам функции

@alexcrz · 18.03.2019, 13:24 **[ТС]**

Нормально в практике открывать файл Excel в котором сразу появляется форма?

Смысл в чём. Пользователь кликает на файл нужной обработки и далее ему не надо знать про макросы... он просто расставляет в окне галки с цифрами, и получает результат.

Как грамотно оформить с минимумом проблем безопасности? Excel точно будет орать, что все сейчас умрут, если открыть и запустить макрос.

Добавлено через 4 минуты
или не через форму, а кнопкой макрос запускать... где, собственно, форма будет?

Добавлено через 5 минут
подозреваю, что лента и панель быстрого запуска должна настраиваться у каждого пользователя... не вариант

Добавлено через 1 час 14 минут
Уже замучился. Как отсортировать сперва по столбцу B, затем D?

Visual Basic

Set sh = ActiveWorkbook.Worksheets(1) 
 
LastRow = sh.Cells(StartRow, SortColumn).End(xlDown).Row
CountRow = LastRow - StartRow 
    sh.sort.SortFields.Clear
    sh.sort.SortFields.Add2 Key:=Range("B" & StartRow & ":B" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    sh.sort.SortFields.Add2 Key:=Range("D" & StartRow & ":D" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With sh.sort
        .SetRange Range("A" & StartRow & ":H" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

@alexcrz · 21.03.2019, 14:52 **[ТС]**

С тестированием пока заминка. На 3 выгрузках работает.

Visual Basic

Sub ShowWindow()
    Window.show
End Sub
Sub sort()
 
Dim xFileName As Variant
Dim Rg As Range
Dim xAddress As String
Dim LastRow As Integer
Dim CountRow As Integer
Dim i As Integer
 
Const StartRow = 3 
Const SortColumn = 4 
Const SumColumn = 2 
   
 
 
    xFileName = Application.GetOpenFilename("csv File (*.csv), *.csv", , "Excel", , False)
    If xFileName = False Then Exit Sub
    On Error Resume Next
    Set Rg = Range("$A$1")
    xAddress = Rg.Address
    With ActiveSheet.QueryTables.Add("TEXT;" & xFileName, Range(xAddress))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1251
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False ' True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
 
Set sh = ActiveWorkbook.Worksheets(1) 
 
LastRow = sh.Cells(StartRow, SortColumn).End(xlDown).Row 
CountRow = LastRow - StartRow 
 
    sh.sort.SortFields.Clear
    sh.sort.SortFields.Add Key:=Range("D" & StartRow & ":D" & LastRow), SortOn:=xlSortOnValues ', Order:=xlAscending, DataOption:=xlSortNormal
    sh.sort.SortFields.Add Key:=Range("B" & StartRow & ":B" & LastRow), SortOn:=xlSortOnValues ', Order:=xlAscending, DataOption:=xlSortNormal
    With sh.sort
        .SetRange Range("A" & StartRow & ":H" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
  
  
For i = 1 To CountRow
    If Cells(LastRow, SortColumn) = Cells(LastRow - 1, SortColumn) Then
        Cells(LastRow - 1, SumColumn) = Cells(LastRow - 1, SumColumn) & ", " & Cells(LastRow, SumColumn)
        sh.Cells(LastRow, SortColumn).EntireRow.Delete
    End If
    LastRow = LastRow - 1
Next i
 
End Sub

@alexcrz 13 / 16 / 5 Регистрация: 26.03.2013 Сообщений: 142
		1
	Сортировка, сравнение, объединение, удаление 14.03.2019, 10:49. Показов 1608. Ответов 15 Метки нет (Все метки) Здравствуйте. Дана таблица из 9 столбцов 1. Сортируем по 5 столбцу 2. Сравниваем ячейки 5 столбца, если две ячейки совпадают 3. то объединяем ячейки 3 столбца через "," 4. удаляем одну строку, чтобы не было дублей В первую очередь прошу ссылки "куда читать" для экономии времени. Алгоритм мне понятен, но синтаксиса не знаю вообще. Вчера начал изучать VBA. Надо к понедельнику разобраться, как решать такие задачи, и где есть читабельные справочник/кукбук. Добавлено через 2 минуты да, все ячейки текстовые Добавлено через 8 минут 1 ..... a2 ..... qwert ..... ..... ..... ..... 2 ..... b5 ..... qwert ..... ..... ..... ..... 3 ..... j2 ..... zwqw ..... ..... ..... ..... получаем 1 ..... a2, b5 ..... qwert ..... ..... ..... ..... 3 ..... j2 ..... zwqw ..... ..... ..... ..... Добавлено через 9 минут еще цикл получаем с первой строки до последней минус один - количество строк произвольно 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	14.03.2019, 11:06	3
	Сообщение от alexcrz удаляем одну строку - т.к. Вы новичёк, сразу подскажу что для этого правильнее циклом идти снизу вверх. Если строки удалять не сразу все, а по одной. 1

@alexcrz 13 / 16 / 5 Регистрация: 26.03.2013 Сообщений: 142
	14.03.2019, 11:23 [ТС]	4
	в чём разница? по одной, так как надо значение 3-ого столбца из удаляемой строки забирать. Забрали - удалили. Может 3-10 строк одинаковых. Получим 1 ..... a2, b5, a3, a6, b99, c7, c4 ..... qwert ..... ..... ..... ..... кстати, надо добавлять повторную проверку изменённой строки со следующей после удалённой! Добавлено через 5 минут Hugo121, я понял, спасибо! 0

@alexcrz 13 / 16 / 5 Регистрация: 26.03.2013 Сообщений: 142
	14.03.2019, 16:35 [ТС]	6
	мне, на самом деле, всё в тему, что касается 4 пунктов + циклы. Спасибо. наютубил удаление дубликатов пачкой + поиск начала и конца таблицы для цикла... очень долго ищутся банальные вещи. сходу найти точно такую же задачу не получилось, по кускам собирается, включая вашу помощь. 0

@alexcrz 13 / 16 / 5 Регистрация: 26.03.2013 Сообщений: 142
	15.03.2019, 15:51 [ТС]	11
	вроде да... будут разные значения - перейдёт на следующую пару LastRow и LastRow - 1 Будут одинаковые - склеит значения двух ячеек и удалит строку, перейдет на следующую пару да, с синтаксисом борюсь - спасибо Добавлено через 8 минут значения в столбце я отсортировал... пока криво с магическими константами, сегодня доделаю далее увидел окна на ютубе, куда пользователь может вводить значения перед обработкой буду мучить ввод "столбцов сортировки", "столбцов объединённых данных", "строки начала таблицы" на этой основе можно будет проводить модернизацию. Пока без понятия, что за разнообразие выгрузки мне предстоит ставить на конвейер. Хотя макроса с циклом мне сейчас выше крыше под конкретную задачу. Остальное для самообразования. 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	15.03.2019, 17:44	13
	Для работы и самообразования нужно изучить массивы и словари. И коллекции. 0

@alexcrz 13 / 16 / 5 Регистрация: 26.03.2013 Сообщений: 142
	16.03.2019, 13:57 [ТС]	14
	мысль о сортировке скопилась a1 a10 a2 a3 тут уже моё невежество в Excel. При этом я понимаю, что может быть и такое aaaaa1 aaaaa10 aaaaa2 куда посмотреть? я вопрос не могу Гуглу сформулировать. Логически вижу деление на текстовую и числовую часть + сортировка пузырьком Добавлено через 7 минут у меня и склеенные ячейки идут без предварительной сортировки c9, c10, c8, c7 отсортирую до цикла, - будет c7, c8, c9, c10 Добавлено через 6 минут думаю надо сперва 3 столбец сортировать, затем 5, затем уже склеивать 3 интересен алгоритм сортировки рекодером. При сортировке 5 столбца, 3 столбец перемешан не будет? пойду читать мануал к параметрам функции 0