Сума по цвят - Примери за VBA код

Следващата функция изчислява общата стойност на всички клетки в определен диапазон, които са с определен цвят:

За съжаление, няма функция SUMIF, която да се сумира въз основа на цвета на клетката. Ако искате да сумирате по цвят, ще трябва да създадете функция в рамките на VBA.
За да използвате този код: Отворете редактора на Visual Basic (Alt + F11), Вмъкнете нов модул (Вмъкване> Модул) и копирайте и поставете желания код в модула.

Функция за сумиране по цвят

1234567891011121314151617181920 Функция Color_By_Numbers (Color_Range As Range, Color_Index As Integer) Като Double'Dim Color_By_Numbers As DoubleDim Cell„Ще разгледа клетките, които са в диапазона и ако„цветното вътрешно свойство съответства на необходимия цвят на клетката'тогава ще се сумира„Обхват през цикълЗа всяка клетка в Color_RangeАко (Cell.Interior.ColorIndex = Color_Index) ТогаваColor_By_Numbers = Color_By_Numbers + Cell.VueueКрай АкоСледваща клеткаКрайна функция

Това на практика е „сума по цвят“ - така че ако познавате 56 цветната палитра на Excel и знаете например, че цвят 4 е светло зелен, следното извикване:

Color_By_Numbers (“A1: P20”, 4)

ще сумира стойностите за всички клетки в диапазона A1: P20, които са светлозелени на цвят.

За да улесните използването на функцията, следната подпрограма ще определи общата стойност за всеки от 56 -те цвята на Excel. Той също така дава цялата палата, така че е лесно да се види индексният номер за всеки цвят.

Подпрограмата се извиква на лист 1 и разглежда диапазона

12345678910111213141516171819202122 Private Sub CommandButton1_Click ()„Ще разгледам всеки цвят и ще изготвя обобщена таблица със стойности'на лист 1 в клетка А1 и надолуDim Current_Color_Number As IntegerDim Color_Total As DoubleЗа Current_Color_Number = 1 до 56Color_Total = Color_By_Numbers (Sheets ("Sheet2"). Range ("a11: aa64"), Current_Color_Number)Работни листове ("Sheet1"). Диапазон ("A1"). Отместване (Current_Color_Number, 0) = Current_Color_NumberРаботни листове ("Sheet1"). Диапазон ("A1"). Офсет (Current_Color_Number, 0) .Interior.ColorIndex = Current_Color_NumberАко Color_Total 0# ТогаваРаботни листове ("Sheet1"). Диапазон ("a1"). Офсет (Current_Color_Number, 1) .Value = Color_TotalКрай АкоСледващ Current_Color_NumberEnd Sub

За да изтеглите XLS файла, моля кликнете тук

Така ще помогнете за развитието на сайта, сподели с приятелите си

wave wave wave wave wave