Дело в том что, если в графе цена стояло "0", то Excel спотыкался и присваивал минимальное значению "0", но этот ноль означает лишь отсутствие товара у данного поставщика, а вовсе не минимальную цену.
Итак имеем:
Нужно заполнить три столбца и посчитать суммы по каждому из поставщиков.
Для начала создадим кнопку для вызова формы, в которой можно настроить различные параметры. Код выгляди так:
Private Sub OptionButton_Click()
UserForm1.Show
End Sub
Так же для хранения названия поставщика и его суммы был сделан класс:
Private Type Postavshik
Name As String 'Наименование поставщика.
Total As Double ' Сумма по данному поставщику.
End Type
Ну и собственно вызываем форму. Я примерно сделал такую:
10 текст боксов с описанием.
Рассмотрим все входные данные:
LetterStart = TextBox1.Value 'Считывается название первого столбца, из которого будут браться поставщики.
LetterEnd = TextBox2.Value 'Считывается название последнего столбца, из которого будут браться поставщики.
Up = CInt(TextBox3.Value) 'Считывается номер первой строки с ценами.
Bottom = CInt(TextBox4.Value) 'Считывается номер последней строки с ценами.
If IsNumeric(TextBox5.Value) = True Then 'Считывается название столбца в который заносится минимальная цена. Или отступ от последнего (правого) столбца с цифрами.
Otstup = CInt(TextBox5.Value) 'Если задан в числовом виде.
Else
Otstup = Asc(TextBox5.Value) - Asc(LetterEnd) 'Если задан в буквенном виде.
End If
StepBukv = CInt(TextBox6.Value) 'Считывается количество столбцов между двумя столбцами с ценами. Если столбцы с ценами идут подряд=1.
Quantity = TextBox7.Value 'Считывается номер столбца, в котором указывается необходимое количество заказа для расчёта минимальной суммы.
LineSupplier = TextBox8.Value 'Считывается номер строки, в которой хранятся данные о различных поставщиках.
MinTotal = TextBox9.Value 'Считываем название столбца, куда будут сохраняться минимальные суммы(минимальная цена*необходимое количество).
Range(MinTotal + ":" + MinTotal).NumberFormat = "0.00" 'Задаем формат для столбца с минимальными суммами.
MinCostSupplier = TextBox10.Value 'Считываем названия столбца, куда необходимо сохранять название поставщика с минимальной ценой.
MinPrice = 30000 'Минимальная цена по умолчанию. Цена поставщки должна быть меньше, чтобы стать минимальной.
missgoods = "Нет у поставщиков." 'Сообщение об отсутсвии товара у поставщика.
Length = ((Asc(LetterEnd) - Asc(LetterStart) - 1) / StepBukv) 'Вычисляется длина массива, в который будут заносится поставщики.
Dim q() As Variant 'Создается массив в котором хранятся названия столбцов с поставщиками.
ReDim q(Length) 'Задается размер этого массива.
Dim Supplier() As Postavshik ' Создается массив в котором хранятся названия поставщиков и суммы.
ReDim Supplier(Length) 'Задается размер этого массива.
Min = MinPrice 'Задается минимальное значение для заданного массива.
Потом заполняем массивы
For i = 0 To Length
q(i) = Chr(Asc(LetterStart) + i * StepBukv) 'Задается массив названий столбцов (A,B,C,D,E,F,G,H) согласно заданным параметрам.
Supplier(i).Name = Range(q(i) + LineSupplier) 'Сохраняются названия поставщиков в читаемом формате, по заданным условиям.
Supplier(i).Total = 0 'Заносится сумма заказа для каждого из поставщиков.
Next i
Теперь в цикле проходим сначала по всем строкам, а потом по всем столбцам.
For j = Up To Bottom
For Each c In q
If Range(c + CStr(j)).Value < Min And Range(c + CStr(j)).Value > 0 Then 'Вычисляется минимальная цена по строке товара.
Min = Range(c + CStr(j)).Value
Range(MinCostSupplier + CStr(j)).Value = Range(c + LineSupplier).Value 'Записывается название поставщика для полученной минимальной цены.
End If
Next c
If Min = MinPrice Then 'Проверка условия на наличие у поставщика (изменилась ли Min), если нет то присваивается значение "Нет у поставщика"
Min = missgoods
Range(MinCostSupplier + CStr(j)).Value = Min 'В название поставщика записывается сообщение из missgoods.
End If
Range(Chr(Asc(LetterEnd) + Otstup) + ":" + Chr(Asc(LetterEnd) + Otstup)).NumberFormat = "0.00" 'Задаём формат для столбца с минимальной ценой поставщика.
Range(Chr(Asc(LetterEnd) + Otstup) + CStr(j)).Value = Min 'Записывается минимальная цена
If Range(Chr(Asc(LetterEnd) + Otstup) + CStr(j)).Value = missgoods Then 'Если в поставщике значение missgoods, то сумма=0
Range(MinTotal + CStr(j)).Value = 0
Else
Range(MinTotal + CStr(j)).Value = Min * Range(Quantity + CStr(j)).Value 'иначе рассчитывается сумма.
End If
'Заносится в свойства массива Supplier.Price суммы.
For w = 0 To Length
If Range(MinCostSupplier + CStr(j)).Value = Supplier(w).Name Then
Supplier(w).Total = Supplier(w).Total + Range(MinTotal + CStr(j)).Value
End If
Next w
Min = MinPrice ' При прохождении одного товара(позиции,строки) минимальное значение сбрасывается.
Next j
For ii = 0 To Length ' Записывается на 2 строки ниже последней(Bottom + 2) итоговые суммы по поставщикам.
Range(MinTotal + (CStr(Bottom + 2 + ii))).Value = Supplier(ii).Name + ":"
Range(MinCostSupplier + (CStr(Bottom + 2 + ii))).Value = Supplier(ii).Total
Next ii
Ну и собственно в конце можно скрыть форму, или сохранить параметры.
Собственно из-за чего всё затевалось, так это:
If Range(c + CStr(j)).Value < Min And Range(c + CStr(j)).Value > 0 Then 'Вычисляется минимальная цена по строке товара.
Min = Range(c + CStr(j)).Value
Range(MinCostSupplier + CStr(j)).Value = Range(c + LineSupplier).Value 'Записывается название поставщика для полученной минимальной цены.
End If
Собственно результат работы:
Не знаю уж почему программисты из Microsoft не подумали об этом (всего лишь 1 строчка кода). В которой сравнивается текущее значение с минимальным. Надеюсь в новых версиях этой замечательной программы будет исправлена это досадная оплошность.
Комментариев нет:
Отправить комментарий