Сравнение прайс-листов из кода VBA Excel с помощью массивов: сравнение номенклатуры, добавление новых позиций, корректировка цен на конкретном примере.
Данные для сравнения прайс-листов
Исходный прайс-лист (лист Price текущей рабочей книги ThisWorkbook):
Поступивший прайс-лист (единственный лист файла Price1.xlsx):
Имя файла с поступившим прайс-листом значения не имеет, так как мы будем его выбирать с помощью стандартного диалога выбора файлов.
Для фиксации результатов сравнения прайс-листов создадим новый лист NewPrice в книге ThisWorkbook и внесем в него информацию из исходного и поступившего прайс-листов:
- Добавим на лист
NewPriceвсе позиции номенклатуры исходного листаPriceи новые позиции из поступившего файлаPrice1.xlsx. - На новом листе
NewPriceзаменим цены совпадающих позиций номенклатуры в исходном и поступившем листах на цены поступившего листа, увеличенные на 10% с округлением до рублей (сделаем наценку). - Увеличим на листе
NewPriceцены новых позиций на 10% с округлением до рублей (сделаем наценку). - Скопируем форматы столбцов таблицы на листе
Priceв таблицу на листеNewPrice.
В результате должна получиться следующая таблица (без окончательной сортировки по алфавиту, чтобы были видны добавленные снизу новые позиции номенклатуры):
Для реализации кода сравнения прайс-листов в Excel будем использовать массивы, в которых циклы VBA работают намного быстрее, чем в диапазонах ячеек на рабочем листе.
Манипуляции с номенклатурой и ценами, описанные в списке выше, будут произведены в соответствующих массивах.
Сравнение прайс-листов в VBA Excel
Код VBA Excel для сравнения двух прайс-листов с подробными комментариями:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
Sub SravneniyePraysListov() Dim s As String, myBook As Workbook, arr1() As Variant, _ arr2() As Variant, arr3() As Variant, n As Long, n1 As Long, _ n2 As Long, i1 As Long, i2 As Long, myBool As Boolean 'Открываем стандартный диалог выбора файлов s = Application.GetOpenFilename("Файлы Excel,*.xls*", , "Выбор файла") 'Проверяем существование файла (выход из диалога без выбора файла) If Dir(s) = "" Then MsgBox "Файл не выбран!", 48: Exit Sub 'Открываем файл с поступившем прайс-листом 1 Set myBook = Workbooks.Open(Filename:=s) With myBook.ActiveSheet.Range("A1").CurrentRegion 'Копируем данные поступившего прайс-листа 1 в массив ar1 arr1 = .Value 'Определяем количество строк в таблице поступившего прайс-листа 1 n1 = .Rows.Count End With 'Закрываем файл с прайс-листом 1 myBook.Close 'Переопределяем массив arr3 до размерности табличной части поступившего прайс-листа 'на случай, если все позиции номенклатуры окажутся новыми ReDim arr3(1 To n1 - 1, 1 To 3) With ThisWorkbook.Sheets("Price").Range("A1").CurrentRegion 'Копируем данные текущего прайс-листа в массив ar2 arr2 = .Value 'Определяем количество строк в таблице текущего прайс-листа n2 = .Rows.Count End With 'Сравниваем по очереди каждое наименование товара поступившего 'прайс-листа (arr1) с наименованиями исходного прайс - листа (arr2) For i1 = 2 To n1 For i2 = 2 To n2 'Если наименования совпадают, перезаписываем из arr1 в arr2 единицу 'измерения и цену, которую увеличиваем на 10%, т.е. умножаем на 1.1, 'а переменной myBool присваиваем значение True If arr1(i1, 1) = arr2(i2, 1) Then arr2(i2, 2) = arr1(i1, 2) arr2(i2, 3) = WorksheetFunction.Round(arr1(i1, 3) * 1.1, 0) myBool = True End If Next 'Если совпадения позиций номенклатуры при прохождении второго цикла не было, 'записываем текущую строку в массив arr3 (с пересчетом цены) If myBool = False Then n = n + 1 arr3(n, 1) = arr1(i1, 1) arr3(n, 2) = arr1(i1, 2) arr3(n, 3) = WorksheetFunction.Round(arr1(i1, 3) * 1.1, 0) End If myBool = False Next With ThisWorkbook 'Активируем текущую книгу, чтобы использовать короткие ссылки на листы и диапазоны .Activate 'Создаем новый лист с именем "NewPrice", который автоматически становится активным .Sheets.Add.Name = "NewPrice" End With Range(Cells(1, 1), Cells(n2, 3)) = arr2 Range(Cells(n2 + 1, 1), Cells(n2 + n, 3)) = arr3 'Копируем форматы таблицы "Price" на лист "NewPrice" Sheets("Price").Columns("A:C").Copy Columns("A:C").PasteSpecial Paste:=xlPasteFormats 'Если в исходной таблице числовой или денежный формат задан не всему столбцу 'с ценами, тогда следует добавить строку, задающую формат третьей графы новой таблицы Range(Cells(2, 3), Cells(n2 + n, 3)).NumberFormat = "#,##0 $" 'Сортируем таблицу по алфавиту With Sheets("NewPrice").Sort .SortFields.Clear .SortFields.Add Key:=Range("A2") .SetRange Range(Cells(2, 1), Cells(n2 + n, 3)) .Apply End With 'Добавляем границы ячеек Range(Cells(1, 1), Cells(n2 + n, 3)).Borders.LineStyle = True 'Передаем фокус первой ячейке Range("A1").Select End Sub |
Результат работы кода в виде таблицы с окончательной сортировкой по алфавиту и границами ячеек:
При запуске процедуры SravneniyePraysListov книга с кодом должна быть активной, поэтому мы добавили строку ThisWorkbook.Activate. Например, если мы вручную откроем книгу Price1.xlsx, которая станет активной, и запустим процедуру SravneniyePraysListov из редактора VBA, то получим кучу ошибок, так как использовали короткие ссылки: на листы без указания книги и на диапазоны без указания книги и листа.