Предложение более эффективного способа удаления дубликатов через столбец слева направо вместо использования оператора if

54
6

У меня есть эта таблица:

Year    apple    apple     apple     apple    apple    apple     orange    orange     orange    orange    grape     grape    grape    durian    durian
1987
1988
1989
1990
1991
1992
1993

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

Year    apple    orange    grape   durian
1987
1988
1989
1990
1991
1992
1993

В настоящее время я использую оператор if для удаления, что очень неэффективно.

Sub test()
Dim i As Integer

Worksheets("Sheet1").Activate
lastcol = 1 + Cells(1, Columns.Count).End(xlToLeft).Column 'define last column

Range(Cells(1, 2), Cells(1, lastcol)).Select

Selection.Sort Key1:=Range("C1:Z1"), Order1:=xlAscending,
Orientation:=xlLeftToRight 'sort the column alphabetically

For i = 2 To lastcol
If Cells(1, i).Value = Cells(1, i).Offset(0, 1).Value Then
Cells(1, i).Select
Selection.Delete shift:=xlToLeft
If Cells(1, i).Value = Cells(1, i).Offset(0, 1).Value Then
Cells(1, i).Select
Selection.Delete shift:=xlToLeft
If Cells(1, i).Value = Cells(1, i).Offset(0, 1).Value Then
Cells(1, i).Select
Selection.Delete shift:=xlToLeft
If Cells(1, i).Value = Cells(1, i).Offset(0, 1).Value Then
Cells(1, i).Select
Selection.Delete shift:=xlToLeft
If Cells(1, i).Value = Cells(1, i).Offset(0, 1).Value Then
Cells(1, i).Select
Selection.Delete shift:=xlToLeft
Else
End If
End If
End If
End If
End If

Next
End Sub

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

Может быть, может быть достаточно эффективным, я тоже могу пропустить процесс сортировки?

спросил(а) 2018-07-13T06:06:00+03:00 1 год, 10 месяцев назад
1
Решение
65

или вы можете использовать объект SortedList

Sub ProcessRow()
Dim cell As Range, list As Object, j As Long

Set list = CreateObject("System.Collections.SortedList")
With Worksheets("Sheet1")
With .Range("B1", .Cells(1, .Columns.Count).End(xlToLeft))
For Each cell In .Cells
If Not list.contains(cell.Value2) Then list.Add cell.Value2, 1
Next
.ClearContents
For j = 0 To list.Count - 1
.Cells(1, j + 1).Value = list.getkey(j)
Next
End With
End With
End Sub

ответил(а) 2018-07-13T09:54:00+03:00 1 год, 10 месяцев назад
54

Обычные, использовать коллекции для удаления дубликатов. Я использовал ArrayLists для этого метода сортировки.


Sub ProcessRow()
Dim cell As Range, Target As Range, list As Object
Set list = CreateObject("System.Collections.ArrayList")

With Worksheets("Sheet1")
Set Target = .Range("B1", .Cells(1, .Columns.Count).End(xlToLeft))
End With

For Each cell In Target
If Not list.contains(cell.Value) And cell.Value <> "" Then list.Add cell.Value
Next

list.Sort
Target.ClearContents
Target.Resize(1, list.Count).Value = list.ToArray
End Sub

ответил(а) 2018-07-13T09:14:00+03:00 1 год, 10 месяцев назад
52

Пытаться,

dim i as long

with worksheets("sheet1")
for i=.cells(1, .columns.count).end(xltoleft).column to 2 step -1
if application.match(.cells(1, i), .rows(1), 0) < i then
.columns(i).entirecolumn.delete
end if
next i

'optional lateral sorting of first row only
With .Range(.Cells(1, "B"), .Cells(1, .Columns.Count).End(xlToLeft))
.Cells.Sort Key1:=.Cells(1), Order1:=xlAscending, _
Orientation:=xlLeftToRight, Header:=xlNo
End With

'optional lateral sorting of all rows according to first row as key
With .Range(.Cells(1, "B"), .Cells(.cells(.rows.count, "A").end(xlup).row, .Columns.Count).End(xlToLeft))
.Cells.Sort Key1:=.Cells(1), Order1:=xlAscending, _
Orientation:=xlLeftToRight, Header:=xlNo
End With

end with

ответил(а) 2018-07-13T06:11:00+03:00 1 год, 10 месяцев назад
Ваш ответ
Введите минимум 50 символов
Чтобы , пожалуйста,
Выберите тему жалобы:

Другая проблема