Question

我写了一个完整工作的VBA宏，它通过输入的客户端ID并返回该客户的指定佣金。

代码100％有效，但我需要这样才能让我的老板能够轻松地将新客户的特殊佣金％添加到列表中，而无需通过VBA代码。

如何制作一个简化的VBA宏，或者只是输入一个Excel函数来完成我下面的代码所做的操作，但是让它与特殊的klient表一致？

主Excel表格如下所示：

具有特殊klients，佣金，货币，市场的表格如下所示：

Option Explicit

Sub komisijas_calc_Click()

'Declare the variables
Dim klienta_nr As Long
Dim ISIN As String
Dim Cena As Double
Dim Skaits As Double
Dim Komisija As Double
Dim vk As String
Dim Summa As Double
Dim kSheet As Worksheet

Dim lngFirstRow As Long: lngFirstRow = 2
Dim lngLastRow  As Long
Dim lngCol      As Long: lngCol = 2
Dim lngCounter  As Long
Dim lngKom As Long: lngKom = 11




Set kSheet = ThisWorkbook.Sheets("spec_klienti")


With Worksheets(1)
    lngLastRow = .Cells(.Rows.Count, lngCol).End(xlUp).Row

    For lngCounter = lngFirstRow To lngLastRow

    klienta_nr = Range("B" & lngCounter).Value
    ISIN = Range("E" & lngCounter).Value
    Cena = Range("H" & lngCounter).Value
    Skaits = Range("I" & lngCounter).Value
    vk = Range("D" & lngCounter).Value
    Summa = Cena * Skaits


Select Case klienta_nr



    Case 111111
                '(Vācija, Francija, Nīderlandes, Itālija, Īrija) - 30 EUR MIN
                If klienta_nr = 111111 And (Left(ISIN, 2) = "DE" Or Left(ISIN, 2) = "FR" Or Left(ISIN, 2) = "NL" Or Left(ISIN, 2) = "IT" Or Left(ISIN, 2) = "IE") Then
                    Komisija = Summa * 0.01
                    .Cells(lngCounter, lngKom) = Komisija
                        End If
                If klienta_nr = 111111 And Komisija <= 30 Then
                    .Cells(lngCounter, lngKom) = 30
                        End If


                If klienta_nr = 1111111 And (Left(ISIN, 2) <> "DE" Or Left(ISIN, 2) <> "FR" Or Left(ISIN, 2) <> "NL" Or Left(ISIN, 2) <> "IT" Or Left(ISIN, 2) <> "IE") Then
                    Komisija = Summa * 0.003
                    If Komisija >= 40 Then
                        .Cells(lngCounter, lngKom) = 40
                            End If
                        End If


    Case 2222222
                '(Vācija, Francija, Nīderlandes, Itālija, Īrija) - 30 EUR MIN
                If klienta_nr = 222222 And (Left(ISIN, 2) = "DE" Or Left(ISIN, 2) = "FR" Or Left(ISIN, 2) = "NL" Or Left(ISIN, 2) = "IT" Or Left(ISIN, 2) = "IE") Then
                    Komisija = Summa * 0.01
                    .Cells(lngCounter, lngKom) = Komisija
                        End If
                'Set 30 EUR Min
                If klienta_nr = 2222222 And Komisija <= 30 Then
                    .Cells(lngCounter, lngKom) = 30
                        End If

                If klienta_nr = 2 And (Left(ISIN, 2) <> "DE" Or Left(ISIN, 2) <> "FR" Or Left(ISIN, 2) <> "NL" Or Left(ISIN, 2) <> "IT" Or Left(ISIN, 2) <> "IE") Then
                    GoTo AllElseFails
                        End If


Case Else

AllElseFails:

              'IP2, 0.03% komisija, 40 EUR/USD Max
                If Right(vk, 1) = 1 Or Right(vk, 1) = 8 Then
                    Komisija = Summa * 0.003
                    .Cells(lngCounter, lngKom) = Komisija
                        End If
              'IP1, 0.1% komisija, 40 EUR/USD Max
                If Right(vk, 1) = 7 Then
                    Komisija = Summa * 0.01
                    .Cells(lngCounter, lngKom) = Komisija
                        End If
                'Komisija MAX is 40, so anything >=40 equals 40
                If Komisija >= 40 Then
                    .Cells(lngCounter, lngKom) = 40
                        End If
            'End If
     End Select
   Next lngCounter
  End With
End Sub

简化VBA代码

0 个答案: