Excel VBA - Извличане на уникалните клетки от колона и сумиране по съвпадение. HELP!!

Автор	Съобщение
phrozencrew Чет, 11.12.08, 19:37	Здравейте хора, Нещо блокирах. То толкова пумия ми се изля, че чак се чудя от клеветни как съм жив , но както и да е. Ще съм особено благодарен, ако ми дадете поне насока за мислене на следния проблем. Имам екселски файл със следната информация във Sheet1: A____B 0001 5 0001 66 0002 12 0002 11 0002 7 0002 3 0003 7 0003 5 0003 13 Искам чрез VBA извлека информацията, така че, да се сумират всички клетки от колона B, които имат еднакви стойности в колона A. Извлечените суми да се запишат в Sheet2 като се отбележат на кои стойности от колона A съответстват сумите. ето така: A____B 0001 71 0002 33 0003 25 До сега стигнах до някъде, но нещо дребно (или едро) ми бяга. Стрмежа ми е да работя все едно с 2 масива. И ето каква глупост сътворих: Sub Makro1() Dim tmp   Dim rng As Range   Dim Count Count = 1 For i = 2 To 12 If Worksheets("Sheet1").Cells(i, 1) <> Worksheets("Sheet1").Cells(i + 1, 1) Then Cells(Count, 1) = Worksheets("Sheet1").Cells(i, 1) Count = Count + 1 End If Next i   For i = 2 To 12 Cells(i, 2) = Application.SumIf(Worksheets("Sheet1").Range("A3:B20"), Worksheets("Tabelle6").Cells(i, 1).Text, Range("B3:B20")) Next i   End Sub Ще съм благодарен за всяка идея и наклон на мислене! Предварително ви благодаря! редактиран от phrozencrew на 11.12.08 19:41
	Отговор  За печат
phrozencrew Съб, 13.12.08, 09:31	Решението е било простичко, но човек като не пише всеки ден на Visual Basic for Applications губи тренинг. А уж го обичам Excel-a. Sub cons() Count = 1 Sum = Worksheets("Sheet1").Cells(1, 2).Value For i = 2 To 12 If Worksheets("Sheet1").Cells(i, 1) = Worksheets("Sheet1").Cells(i - 1, 1) Then Sum = Sum + Worksheets("Sheet1").Cells(i, 2).Value Else Worksheets("Sheet2").Cells(Count, 1).NumberFormat = "@" Worksheets("Sheet2").Cells(Count, 1).Value = Worksheets("Sheet1").Cells(i - 1, 1).Value Worksheets("Sheet2").Cells(Count, 2).Value = Sum Count = Count + 1 Sum = Worksheets("Sheet1").Cells(i, 2).Value End If Next i End Sub Много полезен код за счетоводна обработка PS: Лека корекция на изходното форматиране за да може 0001 да излезе като текст. Добавих: Worksheets("Sheet2").Cells(Count, 1).NumberFormat = "@" sum_unique.xls редактиран от phrozencrew на 13.12.08 09:41
	Отговор  За печат
rumen8580 Съб, 13.12.08, 22:22	ами че това е точно онова което трябваше на даскалите да си попълнят училищните програми със съдържание за учениците т.е.пишем Маринова        клас 11 излиза физика смяна 2 понеделник начало на часа---- дата година---- дано не се лъжа но с малко преработка ще стане супер. още повече че ехеl'a e лицензиран за образованието и самото то няма да дава пари за софтуер онагледяващ труда на даскаля. нещата ти се записват дано нямаш претенции в бъдеще за алгоритъм и код не само за странирането чакаме твоите идеи с нужното уважение.
	Отговор  За печат

Коментар