Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Проставить количество значений - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Проставить количество значений (Макросы/Sub)
Проставить количество значений
ant6729 Дата: Четверг, 01.09.2016, 16:41 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
[vba]
Код

Dim uniqueLetters As New Collection
On Error Resume Next
For Each Cell In Range("A1:A8")
uniqueLetters.Add Cell.Value, Cell.Value
Next Cell
On Error GoTo 0

For i = 1 To uniqueLetters.Count
Cells(i, "C") = uniqueLetters.Item(i)
Next
[/vba]

Код подсчитывает количество и в соседнюю колонку выводит коллекцию уникальных значений

А как сделать, чтобы в следующей 3 колонке появлялось количество этих уникальных значений из первой колонки?
К сообщению приложен файл: Collections.xlsm (13.8 Kb)
 
Ответить
Сообщение[vba]
Код

Dim uniqueLetters As New Collection
On Error Resume Next
For Each Cell In Range("A1:A8")
uniqueLetters.Add Cell.Value, Cell.Value
Next Cell
On Error GoTo 0

For i = 1 To uniqueLetters.Count
Cells(i, "C") = uniqueLetters.Item(i)
Next
[/vba]

Код подсчитывает количество и в соседнюю колонку выводит коллекцию уникальных значений

А как сделать, чтобы в следующей 3 колонке появлялось количество этих уникальных значений из первой колонки?
Автор - ant6729
Дата добавления - 01.09.2016 в 16:41
sboy Дата: Четверг, 01.09.2016, 16:46 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Цитата ant6729, 01.09.2016 в 16:41, в сообщении № 1
количество этих уникальных

вот здесь у Вас количество(передайте в значение нужной ячейки)
[vba]
Код
uniqueLetters.Count
[/vba]

Яндекс: 410016850021169
 
Ответить
Сообщение
Цитата ant6729, 01.09.2016 в 16:41, в сообщении № 1
количество этих уникальных

вот здесь у Вас количество(передайте в значение нужной ячейки)
[vba]
Код
uniqueLetters.Count
[/vba]
Автор - sboy
Дата добавления - 01.09.2016 в 16:46
Udik Дата: Четверг, 01.09.2016, 16:52 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
Что-то не похоже, что макрос подсчитывает что-либо. Он запоминает уникальные значения, а потом выводит их в столбце С.

вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
СообщениеЧто-то не похоже, что макрос подсчитывает что-либо. Он запоминает уникальные значения, а потом выводит их в столбце С.
Автор - Udik
Дата добавления - 01.09.2016 в 16:52
ant6729 Дата: Четверг, 01.09.2016, 16:55 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
[vba]
Код


For i = 1 To uniqueLetters.Count
Cells(i, "C") = uniqueLetters.Item(i)
Cells(i, "D") = uniqueLetters.Count

[/vba]

Так...что - то получается...
Надо додумать
 
Ответить
Сообщение[vba]
Код


For i = 1 To uniqueLetters.Count
Cells(i, "C") = uniqueLetters.Item(i)
Cells(i, "D") = uniqueLetters.Count

[/vba]

Так...что - то получается...
Надо додумать
Автор - ant6729
Дата добавления - 01.09.2016 в 16:55
ant6729 Дата: Четверг, 01.09.2016, 17:01 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Получается

A A 3
A D 3
D R 3
A
D
R
R
R

Если

[vba]
Код
For i = 1 To uniqueLetters.Count
Cells(i, "B") = uniqueLetters.Item(i)
Cells(i, "C") = uniqueLetters.Count
Next
    
[/vba]

А нужно количество
 
Ответить
СообщениеПолучается

A A 3
A D 3
D R 3
A
D
R
R
R

Если

[vba]
Код
For i = 1 To uniqueLetters.Count
Cells(i, "B") = uniqueLetters.Item(i)
Cells(i, "C") = uniqueLetters.Count
Next
    
[/vba]

А нужно количество
Автор - ant6729
Дата добавления - 01.09.2016 в 17:01
ant6729 Дата: Четверг, 01.09.2016, 17:02 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Цитата Udik, 01.09.2016 в 16:52, в сообщении № 3
Что-то не похоже, что макрос подсчитывает что-либо. Он запоминает уникальные значения, а потом выводит их в столбце С.


Не знаю... изучаю коллекции
Что он делает... может и так
 
Ответить
Сообщение
Цитата Udik, 01.09.2016 в 16:52, в сообщении № 3
Что-то не похоже, что макрос подсчитывает что-либо. Он запоминает уникальные значения, а потом выводит их в столбце С.


Не знаю... изучаю коллекции
Что он делает... может и так
Автор - ant6729
Дата добавления - 01.09.2016 в 17:02
ant6729 Дата: Четверг, 01.09.2016, 17:06 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
А и ещё вопрос... если в столбце А может быть разное количество, как при помощи xlDown провернуть тоже самое?
 
Ответить
СообщениеА и ещё вопрос... если в столбце А может быть разное количество, как при помощи xlDown провернуть тоже самое?
Автор - ant6729
Дата добавления - 01.09.2016 в 17:06
sboy Дата: Четверг, 01.09.2016, 17:09 | Сообщение № 8
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
так вам нужно количество уникальных? (A,R,D)=3?
или количество A, количество R, количество D?

Яндекс: 410016850021169
 
Ответить
Сообщениетак вам нужно количество уникальных? (A,R,D)=3?
или количество A, количество R, количество D?
Автор - sboy
Дата добавления - 01.09.2016 в 17:09
ant6729 Дата: Четверг, 01.09.2016, 17:10 | Сообщение № 9
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Должно получиться

А 3
D 2
R 3
 
Ответить
СообщениеДолжно получиться

А 3
D 2
R 3
Автор - ant6729
Дата добавления - 01.09.2016 в 17:10
sboy Дата: Четверг, 01.09.2016, 17:18 | Сообщение № 10
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
примерно так
[vba]
Код
For i = 1 To uniqueLetters.Count
Cells(i, "B") = uniqueLetters.Item(i)
Cells(i, "C").Value = WorksheetFunction.CountIf(Range("A1:A8"), uniqueLetters.Item(i))
Next
[/vba]

Яндекс: 410016850021169
 
Ответить
Сообщениепримерно так
[vba]
Код
For i = 1 To uniqueLetters.Count
Cells(i, "B") = uniqueLetters.Item(i)
Cells(i, "C").Value = WorksheetFunction.CountIf(Range("A1:A8"), uniqueLetters.Item(i))
Next
[/vba]
Автор - sboy
Дата добавления - 01.09.2016 в 17:18
Udik Дата: Четверг, 01.09.2016, 17:20 | Сообщение № 11
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
Ну так можно
[vba]
Код

Public Sub test()
Dim oDict, arrKey
Dim rowLast As Integer, i%

Set oDict = CreateObject("Scripting.Dictionary")
oDict.CompareMode = 1
With ActiveSheet
rowLast = .UsedRange.Row + .UsedRange.Rows.Count - 1
For i = 1 To rowLast
If Not oDict.exists(.Cells(i, 1).Value) Then
oDict.Add .Cells(i, 1).Value, 1
Else
oDict.Item(.Cells(i, 1).Value) = oDict.Item(.Cells(i, 1).Value) + 1
End If
Next i
arrKey = oDict.keys()

For i = 0 To UBound(arrKey)
.Cells(i + 1, 2) = arrKey(i)
.Cells(i + 1, 3) = oDict.Item(arrKey(i))
Next i
End With

End Sub
[/vba]
К сообщению приложен файл: 0t.xlsm (15.8 Kb)

вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com

Сообщение отредактировал Udik - Четверг, 01.09.2016, 17:22
 
Ответить
СообщениеНу так можно
[vba]
Код

Public Sub test()
Dim oDict, arrKey
Dim rowLast As Integer, i%

Set oDict = CreateObject("Scripting.Dictionary")
oDict.CompareMode = 1
With ActiveSheet
rowLast = .UsedRange.Row + .UsedRange.Rows.Count - 1
For i = 1 To rowLast
If Not oDict.exists(.Cells(i, 1).Value) Then
oDict.Add .Cells(i, 1).Value, 1
Else
oDict.Item(.Cells(i, 1).Value) = oDict.Item(.Cells(i, 1).Value) + 1
End If
Next i
arrKey = oDict.keys()

For i = 0 To UBound(arrKey)
.Cells(i + 1, 2) = arrKey(i)
.Cells(i + 1, 3) = oDict.Item(arrKey(i))
Next i
End With

End Sub
[/vba]
Автор - Udik
Дата добавления - 01.09.2016 в 17:20
ant6729 Дата: Четверг, 01.09.2016, 21:21 | Сообщение № 12
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Спасибо, буду думать
 
Ответить
СообщениеСпасибо, буду думать
Автор - ant6729
Дата добавления - 01.09.2016 в 21:21
sv2014 Дата: Четверг, 01.09.2016, 21:56 | Сообщение № 13
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 226
Репутация: 61 ±
Замечаний: 0% ±

Excel 2013
ant6729, добрый вечер,еще вариант,кнопки test и очистка

[vba]
Код
Sub test()
   Dim z, i&: z = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
With CreateObject("scripting.dictionary"): .CompareMode = 1
  For i = 1 To UBound(z): .Item(z(i, 1)) = .Item(z(i, 1)) + 1: Next
   Range("B1").Resize(.Count, 2).Value = Application.Transpose(Array(.Keys, .items))
End With
End Sub
[/vba]
К сообщению приложен файл: example_1_09_20.xls (33.5 Kb)


Сообщение отредактировал sv2014 - Четверг, 01.09.2016, 21:57
 
Ответить
Сообщениеant6729, добрый вечер,еще вариант,кнопки test и очистка

[vba]
Код
Sub test()
   Dim z, i&: z = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
With CreateObject("scripting.dictionary"): .CompareMode = 1
  For i = 1 To UBound(z): .Item(z(i, 1)) = .Item(z(i, 1)) + 1: Next
   Range("B1").Resize(.Count, 2).Value = Application.Transpose(Array(.Keys, .items))
End With
End Sub
[/vba]
Автор - sv2014
Дата добавления - 01.09.2016 в 21:56
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Проставить количество значений (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!