/
Полезные макросы

Quad.Wiki

Полезные макросы

Owned by Ruslan
Last updated: Feb 06, 2025
3 min read

Здесь информация, куда добавлять макрос:

Настройка прайса: макросы

 

1. Удалить строки в которых дата больше 7 дней от текущей

Данный макрос будет работать только если в файле дата указана в таком же виде, как на вашем компьютере

Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.EnableEvents = False 'количество дней, больше которого удалять i_DAYS = 7 'колонка в которой дата i_COL = 11 'первая строка в которой начинаются товары i_FIRST_ROW = 2 For i = Sheets(1).UsedRange.Rows.Count To i_FIRST_ROW Step -1 s_date = Sheets(1).Cells(i, i_COL).Value if (Trim(s_date) <> "") And IsDate(s_date ) then i_val = DateDiff("d", Now(), s_date) If i_val > i_DAYS Then Sheets(1).Rows(i).Delete End If End If Next i Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True

 

2. Удалить строки из прайса перед загрузкой, при совпадении текста в нескольких колонках

С помощью данного макроса можно перед загрузкой удалять строки из прайса, чтобы какой-то товар вообще не загружался в программу. В тексте макроса указывается список колонок и значений в этих колонках, при совпадении (вхождении) которых строка удаляется. В комментарии в макросе указано как заполнять этот список правил.

По-умолчанию макрос делает поиск вхождения искомой строки в тексте ячейки. Чтобы сработал точный поиск, когда текст ячейки совпадает с искомым значением, перед значением нужно добавить “[=]" , например [=]под заказ

Dim aDict Dim arKey() As Variant Set aDict = CreateObject("Scripting.Dictionary") 'строка с которой начинать start_row = 2 'список удаляемых строк 'первое значение - уникальный ключ для каждой строки, можно просто номер, не обязательно по порядку 'второе значение (в скобках Array) - колонка и текст поиска, для удаления строк 'значения указываются парно, первое значение - номер колонки, второе значение - текст который должен быть в строке чтобы ее удалить 'удаляется только строка, в которой совпали все вхождения (заглавная или нет буквы не имеет значения) 'если перед искомым текстом стоит [=] , то ищется полное совпадение текста в ячейке, без учета маленьких/больших букв aDict.Add "1", Array(3, "блендер", 5, "заказ") aDict.Add "2", Array(3, "Винный шкаф", 4, "MAUNFELD", 5, "Под заказ") aDict.Add "3", Array(3, "блендер", 5, "[=]под заказ") '-------------------------------------------------------- Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.EnableEvents = False 'обрабатываемые листы в файле, через запятую, например Array(1,2,5,7) idx_list = Array(1) for k = lbound(idx_list) to ubound(idx_list) Set sht = Sheets(idx_list(k)) For i = sht.UsedRange.Rows.Count To start_row Step -1 For Each Key In aDict.Keys arKey = aDict.Item(CStr(Key)) bOk = True prm_No = 0 for m = lbound(arKey) to ubound(arKey) if prm_No = 0 Then colIdx = arKey(m) prm_No = prm_No + 1 else if prm_No = 1 Then colText = arKey(m) if InStr(1, colText, "[=]") = 1 Then colText = Replace(colText, "[=]", "") if UCase$(sht.Cells(i, colIdx).Value2) <> UCase$(colText) Then bOk = False Exit For end if else if InStr(1, UCase$(sht.Cells(i, colIdx).Value2), UCase$(colText)) = 0 Then bOk = False Exit For end if end if prm_No = 0 end if end if Next m If (bOk) Then sht.Rows(i).Delete End If Next Next i Next k Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True

 

3. Макросы для белорусских поставщиков

cd-life (Корпоративный стандарт)

макрос очищает первую ячейку, если цвет шрифта красный. Наличие загружается по первой колонке, Нет в наличии, если пусто

SHEET_INDEX = 1 'проверяемая колонка COL_CHECK = 1 'цвет нет в наличии NOT_EXISTS_COLOR = 255 for i = 2 to sheets(SHEET_INDEX).UsedRange.Rows.Count if sheets(SHEET_INDEX).cells(i, COL_CHECK).Font.Color = NOT_EXISTS_COLOR Then sheets(SHEET_INDEX).cells(i, COL_CHECK).Value = "" end if next i

 

Надежная техника

макрос в 20-ую колонку ставит 0, если цвет шрифта в первой колонке красный и 1, если не красный. Наличие загружается по 20-ой колонке, в наличии если текст “1”

 

 

Related content