Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - VBA

Страница: 1 |

 

  Вопрос: сравнение с подсчетом, цикл или перебор? Добавлено: 11.11.08 14:58  

Автор вопроса:  Summer | ICQ: 373-940-353 
встала задача, суть которой такая:

есть два столбца:
1-ый: название чего-то (есть совпадения)
2-ой: числа

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

в итоге должно получиться:
1-ый столбец: названия чего-то (без совпадений, то есть уникальные остались)
2-ой столбец: суммы чисел по названиям.
(эти два столбца по идее рядом создаваться должны)

цикл пробовал, создавал третий столбец, ну что-то не катит никак. Помогите, пожалуйста.

Ответить

  Ответы Всего ответов: 3  

Номер ответа: 1
Автор ответа:
 mc-black



ICQ: 308-534-060 

Вопросов: 20
Ответов: 1860
  Web-сайт: mc-black.narod.ru/dzp.htm
 Профиль | | #1 		Добавлено: 11.11.08 15:49
  1. Option Explicit
  2.  
  3. Sub UniqueSum()
  4.     Dim i As Long
  5.     Dim j As Long
  6.     Dim b As Boolean
  7.     Dim s As Worksheet
  8.     Set s = ThisWorkbook.Worksheets(1)
  9.     i = 1
  10.     Do While Not s.Cells(i, 1).Value = Empty
  11.         b = False
  12.         j = 1
  13.         Do While Not s.Cells(j, 3).Value = Empty
  14.             If s.Cells(j, 3).Value = s.Cells(i, 1).Value Then
  15.                 b = True
  16.                 Exit Do
  17.             End If
  18.             j = j + 1
  19.         Loop
  20.         If b Then
  21.             s.Cells(j, 4).Value = s.Cells(j, 4).Value + s.Cells(i, 2).Value
  22.         Else
  23.             s.Cells(j, 3).Value = s.Cells(i, 1).Value
  24.             s.Cells(j, 4).Value = s.Cells(i, 2).Value
  25.         End If
  26.         i = i + 1
  27.     Loop
  28.     Set s = Nothing
  29. End Sub

Ответить

Номер ответа: 2
Автор ответа:
 Jasmin



Вопросов: 23
Ответов: 417
  Профиль | | #2 Добавлено: 13.11.08 11:16
  'строка 1 название списков
  'A2:B9 - диапазон значений
  'В колонке А название чего-то
  'В колонке B числа
  'В колонке Е список уникальных "названий чего-то"
  'В колонке F сумма чисел этих "названий чего-то"
  
  'удаляем рез-ты из колонок Е и F
  Columns("E:F";).Select
  Selection.Delete Shift:=xlToLeft
 
  'создаем отчет
  ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
                                 SourceData:="Sheet1!R1C1:R9C2";).CreatePivotTable TableDestination:="[Book1]Sheet1!R1C5", _
                                 TableName:="PivotTable1", _
                                 ;DefaultVersion:=xlPivotTableVersion10
  With ActiveSheet.PivotTables("PivotTable1";)
    .ColumnGrand = False
    .RowGrand = False
  End With
  ActiveSheet.PivotTables("PivotTable1";).AddFields RowFields:="List1"
  ActiveSheet.PivotTables("PivotTable1";).PivotFields("Chislo";).Orientation = xlDataField
  
  Range("E14";).Select

Тоже самое можно руками сделать, можно этот кусок в макрос записать.

Ответить

Номер ответа: 3
Автор ответа:
 Summer



ICQ: 373-940-353 

Вопросов: 2
Ответов: 4
  Профиль | | #3 Добавлено: 18.11.08 12:47
благодарю. :)
записал в макрос. )

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам