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

Вход

Регистрация

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

 

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

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Проставить количество значений (Макросы/Sub)
Проставить количество значений
ant6729 Дата: Четверг, 01.09.2016, 16:41 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 0 ±
Замечаний: 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(14Kb)
 
Ответить
Сообщение[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
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 196
Репутация: 48 ±
Замечаний: 0% ±

Excel 2007
количество этих уникальных

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

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

Автор - sboy
Дата добавления - 01.09.2016 в 16:46
Udik Дата: Четверг, 01.09.2016, 16:52 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1202
Репутация: 152 ±
Замечаний: 0% ±

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


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
СообщениеЧто-то не похоже, что макрос подсчитывает что-либо. Он запоминает уникальные значения, а потом выводит их в столбце С.

Автор - Udik
Дата добавления - 01.09.2016 в 16:52
ant6729 Дата: Четверг, 01.09.2016, 16:55 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 0 ±
Замечаний: 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
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 0 ±
Замечаний: 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
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 0 ±
Замечаний: 40% ±

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


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


Не знаю... изучаю коллекции
Что он делает... может и так

Автор - ant6729
Дата добавления - 01.09.2016 в 17:02
ant6729 Дата: Четверг, 01.09.2016, 17:06 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
А и ещё вопрос... если в столбце А может быть разное количество, как при помощи xlDown провернуть тоже самое?
 
Ответить
СообщениеА и ещё вопрос... если в столбце А может быть разное количество, как при помощи xlDown провернуть тоже самое?

Автор - ant6729
Дата добавления - 01.09.2016 в 17:06
sboy Дата: Четверг, 01.09.2016, 17:09 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 196
Репутация: 48 ±
Замечаний: 0% ±

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

Автор - sboy
Дата добавления - 01.09.2016 в 17:09
ant6729 Дата: Четверг, 01.09.2016, 17:10 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 0 ±
Замечаний: 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
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 196
Репутация: 48 ±
Замечаний: 0% ±

Excel 2007
примерно так
[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]
 
Ответить
Сообщениепримерно так
[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
Группа: Друзья
Ранг: Старожил
Сообщений: 1202
Репутация: 152 ±
Замечаний: 0% ±

Excel 2013
Ну так можно
[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(16Kb)


вот вам барабан
яд 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
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
Спасибо, буду думать
 
Ответить
СообщениеСпасибо, буду думать

Автор - ant6729
Дата добавления - 01.09.2016 в 21:21
sv2014 Дата: Четверг, 01.09.2016, 21:56 | Сообщение № 13
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 156
Репутация: 37 ±
Замечаний: 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(34Kb)


Сообщение отредактировал 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 из 11
Поиск:

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