0 / 0 / 0
Регистрация: 16.10.2008
Сообщений: 14
1

Выбрать с первого столбца все уникальные значения

16.10.2008, 17:23. Показов 5501. Ответов 4
Метки нет (Все метки)

Author24 — интернет-сервис помощи студентам
Собственно надо взять с первой колонки все уникальные значения, но...
Есть фрагмент кода, который все что есть в этой колонке заносит в массив:

Visual Basic
1
2
3
4
5
KolCells = .Cells(1, 1).End(xlDown).Row 
KolID = KolCells 
ReDim ID(KolCells) 
For ICells = 1 To KolCells 
ID(ICells) = .Cells(ICells, 1)
Но в этой колонке много повторяющихся значений, а мне надо чтобы занесло только уникальные.

Подсказали пойти типа таким путем:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
.Cells(1, 1).Select
    Selection.Insert Shift:=xlDown
    .Cells(1, 1).Select
    ActiveCell.FormulaR1C1 = ???
    .Select
    .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    .Cells(1, 1).Select
    Selection.Delete Shift:=xlUp
KolCells = .Cells(1, 1).End(xlDown).Row 
KolID = KolCells 
ReDim ID(KolCells) 
For ICells = 1 To KolCells 
ID(ICells) = .Cells(ICells, 1) 
    ActiveSheet.ShowAllData
Как это заставить работать?
Кто может помочь?
0
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
16.10.2008, 17:23
Ответы с готовыми решениями:

Excel найти уникальные значения из первого столбца и фильтровать - не брать пустые значения из 3 столбца
Ребят, помогите осуществить в коде VB в Excel. Сделал в самом доке, а как в коде на VB новичок....

Уникальные значения столбца А по сравнению со столбцом С и уникальные значения в столбце С по сравнению с А?
Ребята всем привет, как реализовать макросом? Есть два столбца А и С в каждом списки...

Выбрать уникальные значения. Выбрать числа которые есть в обоих массивах
Всем доброго времени суток! Ребята , у меня есть 2 массива , они заполняются рандомными числами ,...

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

4
1161 / 288 / 23
Регистрация: 28.09.2008
Сообщений: 553
16.10.2008, 22:14 2
Кроме как сравнивать каждую ячейку с элементами массива ничего предложить не могу (может и можно как-то по другому, я не знаю), собираем только уникальные значения, а потом весь массив выводим в вторую колонку (для проверки):
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Dim ID() As String
Sub Макрос()
Dim i As Integer, j As Integer, x As Integer
ReDim ID(x)
For i = 1 To Cells(1, 1).End(xlDown).Row
    If test(Cells(i, 1).Text) = False Then
        ReDim Preserve ID(x)
        ID(x) = Cells(i, 1).Text
        x = x + 1
    End If
Next i
For i = LBound(ID) To UBound(ID)
    Cells(i + 1, 2).Value = ID(i)
Next i
End Sub
Private Function test(newID) As Boolean
Dim i As Integer
For i = LBound(ID) To UBound(ID)
    If newID = ID(i) Then test = True: Exit Function
Next i
test = False
End Function
P.S. Если будут пустые ячейки в столбце А, то они будут восприниматься как конец столбца. Их вроде можно как-то игнорировать, т.е. найти самую последнюю заполненную ячейку.
0
0 / 0 / 0
Регистрация: 16.10.2008
Сообщений: 14
17.10.2008, 13:11  [ТС] 3
Попробовал, но ниче не вышло, пишет Run-time error '13':Type mismatch (вставлял через Application.Run ). Вот собственно все вместе - исходник, куда вставить фильтр надо - там RED.txt с описанием: http://garden.gov.ua/failo/xls.rar
Мош я че-то вообще не так делаю~?
0
1161 / 288 / 23
Регистрация: 28.09.2008
Сообщений: 553
17.10.2008, 19:43 4
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

Вот, если я правильно поняла, то вот.
Вложения
Тип файла: rar 16.rar (8.7 Кб, 79 просмотров)
1
0 / 0 / 0
Регистрация: 16.10.2008
Сообщений: 14
21.10.2008, 10:52  [ТС] 5
Спасибо, уже работает, если интересно - вот таким путем:

Visual Basic
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
rivate Sub CommandButton1_Click()
 
     Dim MyPath As String 'Путь
     Dim MyFileName As String 'Название файл(ов) которые мы будем открывать
     Dim MyFileName_ As String 'Название файл(ов) которые мы будем открывать
     Dim ID() As Integer 'Массив ID которые по которым мы будет собирать данные
     Dim KolID As Integer 'Произвольное к-во ID?
     Dim KolCells As Integer 'Количество строчек по которым мы будет искать данные
     Dim KolRows As Integer 'Количество столбцов по которым мы будет искать данные
     Dim ICells As Integer, JCells As Integer, ICellsID ' Счетчикu для цикла
     Dim WorkMas() As String
     Dim MasStat() As Integer
     Dim Counter As Integer
     Dim theRange As Range
     Dim uniqueValues As New Collection
     Dim i As Integer
     Dim theArray() 'вот ваш массив
     Dim item As Variant
     Counter = 0
     MyPath_ = "C:\bd\"
     MyPath = "C:\xls\"
  
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Call ImportTXT
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 With ActiveWorkbook.ActiveSheet
            KolCells = .Cells(1, 1).End(xlDown).Row
            KolID = KolCells
            ReDim ID(KolCells)
            For ICells = 1 To KolCells
                            ID(ICells) = .Cells(ICells, 1)
            'все что есть в первом столбце заносим в массив
            Next ICells
 End With
 
 
 ''''''''''''''''''''''''''
      MyFileName_ = "BD.xls" 'Пишем имя файла базы данных
     Workbooks.Open(MyPath_ & "\" & MyFileName_).Activate 'Открываем нужную нам книгу
         With ActiveWorkbook.ActiveSheet
             KolCells = .Cells(1, 1).End(xlDown).Row
             KolRows = .Cells(1, 1).End(xlToRight).Column
             ReDim WorkMas(KolCells, KolRows)
             For ICells = 1 To KolCells
                 For ICellsID = 1 To KolID
If .Cells(ICells, 1) = ID(ICellsID) Then
                         Counter = Counter + 1
                         For JCells = 1 To KolRows
                             WorkMas(Counter, JCells) = .Cells(ICells, JCells)
 
                         ' Если тут есть нужный нам ID то заносим его в память
                         Next JCells
End If
                 Next ICellsID
             Next ICells
         End With
     ActiveWindow.Close 'Закрываем книгу
     ' Все что нам надо у нас есть в памяти=))
     'Все что есть выводим
     ReDim MasStat("20")
     For ICells = 1 To Counter
         For JCells = 1 To KolRows
 
             If WorkMas(ICells, JCells) = "Значение1" Then MasStat(1) = MasStat(1) + 1
             If WorkMas(ICells, JCells) = "Значение2" Then MasStat(2) = MasStat(2) + 1
             Cells(ICells, JCells) = WorkMas(ICells, JCells)
 
         Next JCells
     Next ICells
 
             End Sub
             
             
             Sub ImportTXT()
        Cells(1, 1).Select
        Application.ScreenUpdating = False
         
        MyFile = Application.GetOpenFilename("(*.txt),*.txt)")
     
        If MyFile = False Then Exit Sub
     
        Workbooks.OpenText Filename:=MyFile, Origin:=866, StartRow:=1, _
            DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _
            :=True, Tab:=True, Semicolon:=False, Comma:=False, Space:=True, Other _
            :=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:= _
            True
         
        MyFile = ActiveWorkbook.Name
        Workbooks(MyFile).Sheets(1).UsedRange.AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=ThisWorkbook.Sheets("Лист1").Range("A1"), Unique:=True
         
        Application.DisplayAlerts = False
         
        Workbooks(MyFile).Close
         
        Application.DisplayAlerts = True
         
        Application.ScreenUpdating = True
     
End Sub
0
21.10.2008, 10:52
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
21.10.2008, 10:52
Помогаю со студенческими работами здесь

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

Выбрать уникальные значения
Есть задание - Нужно выбрать из двух (назовём их главными)список, ещё 2 списка(назовём их...

Как выбрать уникальные значения
Приветствую, есть таблица нужно выбрать данные из нескольких столбцов, но нужно чтобы данные были...

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


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
5
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru