Excel создать пользовательскую функцию VBA?

Question

Может кто-нибудь помочь мне создать функцию VBA для выполнения следующего?

В Листе 1 у меня есть 3 столбца A(product) и B(price) которые заполнены 3000 наименованиями, и 3-й столбец C(quantity) который сейчас не заполняется.

Я хочу добавить количество к определенным продуктам, что будет сделано путем нахождения продукта, и введите количество в соответствующую ячейку C.

Затем в Sheet2 или даже указали другую рабочую книгу, чтобы были добавлены только все товары, цены и количество, в которые введено количество.

Например, у меня есть Sheet1:

Я хочу, чтобы лист2 или указанный лист / рабочая книга автоматически заполнялись продуктами и соответствующими им ценами и количеством, в которых есть количества, подобные следующим:

Мне удалось создать функцию Excel, но список продуктов меняется еженедельно, и каждый раз, когда мне приходится копировать / вставлять формулу и адаптировать исходный файл, это доставляет массу хлопот.

Формула, которую я сделал, здесь:

=IFERROR(INDEX('Products'!$A$5:$C$2655,SMALL(IF((0<'Products'!$C$5:$C$2655),MATCH(ROW('Products'!$B$5:$B$2655),ROW('Products'!$B$5:$B$2655))),ROW(A11)),COLUMN(A11))," ")

Answer 1

Этот код VBA будет работать:

Public Sub quantityProducts()
    '**********************
    ' variables
    sourceSheet = "Sheet1" 'name of the source sheet
    destSheet = "Sheet2" 'name of the destination sheet
    titleRow = 1 ' Number of Title Row
    firstRowSource = 2 ' First row of source data
    firstRowDest = 2 'First row of data in destination sheet
    copyTitleRow = True 'Should be title row be copied? True / False
    columnToCheck = 3 'Column that defines if the row must be copied
    '**********************
    Dim wkb As Workbook
    Dim wks, wks1 As Worksheet
    Set wkb = ThisWorkbook
    Set wks = wkb.Worksheets(sourceSheet)
    Set wks1 = wkb.Worksheets(destSheet)
    wks1.Rows.Clear ' Clear the contents of destination sheet
    If copyTitleRow = True Then 'If title row must be copied
        wks.Rows(titleRow).Copy Destination:=wks1.Rows(titleRow)
    End If
    totalrows = wks.Cells(Rows.Count, 1).End(xlUp).Row ' total rows in source
    destRow = firstRowDest
    For i = firstRowSource To totalrows ' iterate through rows
        If wks.Cells(i, columnToCheck) <> "" Then ' If cell in column to check isn't empty
            wks.Rows(i).Copy Destination:=wks1.Rows(destRow) ' Copy from source to destination
            destRow = destRow + 1 ' Increase value of destination row
        End If
    Next i
    a = MsgBox("Finished. Copied " & destRow - firstRowDest & " rows", vbOKOnly)
End Sub

Откройте VBA/Macros с помощью ALT+F11, в ThisWorkbook вставьте новый модуль и вставьте код с правой стороны.

Убедитесь, что значения, присвоенные переменным, совпадают с вашими листами и выполните его, нажав зеленый треугольник.

Я добавил комментарии к коду, чтобы вы поняли, как он работает.

Вы также можете запустить его шаг за шагом, нажав на первую строку, а затем перейти на каждый шаг, нажав клавишу F8.