Пример работы с формированием новых функций в excel, обычный вызов функций из стандартного набора и лёгкое программирование в среде VBA (макросы)

 

Задачанайти на другом листе столбец, и, сравнив совпадающие артикули, все значения по искомому столбцу скопировать на 1-ый листпростой расчёт при взаимодействии 2-х полей  
Решение

1) =ЕСЛИОШИБКА(ВПР(B3;'Комиссии партнеров'!$A$2:$B$52;2;ЛОЖЬ);"")

2) Sub FindString_and_Copy_Сommission_percent()
       
    'Dim work_book As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
        ' Определить ДИАПАЗОНЫ
        Set ws1 = ThisWorkbook.Worksheets("Данные")
        Set ws2 = ThisWorkbook.Worksheets("Комиссии партнеров")
      
    Dim rng1 As Range
    Dim rng2 As Range
        ' Указание диапазона для ПАРТНЁРОВ в таблице "Данные"
        Set rng1 = ws1.Range("B3:B5705")    ' Диапазон, откуда брать значения для сравнения
        ' Указание диапазона для ПАРТНЁРОВ в таблице "Комиссии партнеров"
        Set rng2 = ws2.Range("A2:A52")  ' Диапазон, в котором сравнивать наименования партнёров
        
    Dim rng3 As Range
    Dim rng4 As Range
        ' Указание диапазона для КОМИССИИ в таблице "Данные"
        Set rng3 = ws1.Range("F3:F5705")    ' Диапазон, куда вставлять КОМИССИИ
        ' Указание диапазона для КОМИССИИ в таблице "Комиссии партнеров"
        Set rng4 = ws2.Range("B2:B52")  ' Диапазон, откуда брать КОМИССИИ
        
    
    ' Индексы перебора - для того, чтобы обратиться к полям
   Dim idx_2 As Long, idx_1 As Long
    
   Dim cell_1 As Range
   Dim cell_2 As Range
   
   ' Строка для поиска в артикуле
   Dim searchValue As String
      
idx_1 = 1
 For Each cell_1 In rng1
    ' Ensure cell_1.Value is not empty BEFORE processing by removing both leading and trailing spaces.
    If Trim(cell_1.Value) <> "" Then
      searchValue = cell_1.Value
       'MsgBox "НЕ_Пустая строка #" & cell_1.Row & " - " & searchValue
      idx_2 = 1
      For Each cell_2 In rng2
        If Trim(cell_2.Value) <> "" Then
          If StrComp(cell_2.Value, searchValue, vbTextCompare) = 0 Then
            'MsgBox rng4.Cells(idx_2).Value
            rng3.Cells(idx_1).Value = rng4.Cells(idx_2).Value
          End If
        End If
        idx_2 = idx_2 + 1
      Next cell_2

    End If  ' End the check for cell_1.Value being empty
    idx_1 = idx_1 + 1
  Next cell_1
End Sub

1)=ЕСЛИОШИБКА(E3*F3;"")

2) Function Commission(x As Variant, y As Variant) As Variant
    
    If Not IsNumeric(x) Or x <= 0 Then
        Commission = ""
        Exit Function
    End If

    If Not IsNumeric(y) Or y <= 0 Then
        Commission = ""
        Exit Function
    End If

    'CDbl - convert argument to the Double data
    Commission = CDbl(x) * CDbl(y)
End Function

3)
Sub Calculate_Commission_value()
       
    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet
        
    Dim startRow As Long, endRow As Long
    startRow = 3
    endRow = 5705

    Dim i As Long
    Dim order As Variant, commission_rate As Variant
    Dim result As Variant
    
    Dim rubSymbol As String
    rubSymbol = ChrW(&H20BD)

    For i = startRow To endRow
        ' Read values from columns E and F
        order = ws.Cells(i, "E").Value
        commission_rate = ws.Cells(i, "F").Value

        ' Check if both values are numeric
        If IsNumeric(order) And IsNumeric(commission_rate) Then
            result = order * commission_rate
            ws.Cells(i, "G").Value = result
            ws.Cells(i, "G").NumberFormat = "#,##0.00 " & rubSymbol
'        Else
'            result = ""
        End If
    Next i
End Sub