2017-07-10 7 views
-1

Ich habe eine Funktion erstellt, die eine Kommission des Kunden basierend auf vielen Variablen berechnet.Circular Reference Warnung in VBA-Funktion

Das erste Problem, das ich habe, ist ein Circular Reference Error. Ich verstehe, was es bedeutet, aber ich kann nicht genau herausfinden, woher der Fehler stammt.

Das zweite Problem ist, dass meine ISIN, Cena, Skaits und VK Werte auf eine bestimmte Zelle festgelegt sind, aber ich möchte, dass sie den Werten der aktuellen Zeile entsprechen. Wenn das nicht sinnvoll ist, fragen Sie bitte.

Private Sub CommandButton1_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 x As Integer 

Application.ScreenUpdating = False 
Set kSheet = ThisWorkbook.Sheets("komisijas") 


'Set variables equal to the cell data 
'----------------------------------------------------------- 
'I NEED TO SET THESE TO BE EQUAL TO THE CURRENT ROW'S VALUES 
'----------------------------------------------------------- 
klienta_nr = Range("B2").Value 
ISIN = Range("E2").Value 
Cena = Range("H2").Value 
Skaits = Range("I2").Value 
vk = Range("D2").Value 
Summa = Cena * Skaits 




'--------------------------------------------------------------------------------------------- 
'Start Cases 
'--------------------------------------------------------------------------------------------- 
Select Case klienta_nr 

'Special klient cases 


    Case 10 
       '(Vācija, Francija, Nīderlandes, Itālija, Īrija) - 30 EUR MIN 
       If klienta_nr = 10 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 
        ActiveCell.Value = Komisija 
        End If 
       If klienta_nr = 10 And Komisija <= 30 Then 
        ActiveCell.Value = 30 
        End If 

       'Case where klient is special, but ISIN doesn't apply 
       If klienta_nr = 10 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 
         ActiveCell.Value = 40 
         End If 
       End If 


    Case 11 
       '(Vācija, Francija, Nīderlandes, Itālija, Īrija) - 30 EUR MIN 
       If klienta_nr = 11 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 
        ActiveCell.Value = Komisija 
        End If 
       'Set 30 EUR Min 
       If klienta_nr = 11 And Komisija <= 30 Then 
        ActiveCell.Value = 30 
        End If 

     'End If 


    Case 12 
       '(Ziemeļvastu, Lietuvas, Igaunijas, Vācijas, Francijas, Nīderlandes, Itālijas, Īrijas, Austijas, Beļģijas, Spānijas, Portugāles) 
       If klienta_nr = 12 And (Left(ISIN, 2) = "NO" Or Left(ISIN, 2) = "SE" Or Left(ISIN, 2) = "DK" Or Left(ISIN, 2) = "FI" Or Left(ISIN, 2) = "IS" Or Left(ISIN, 2) = "LT" Or Left(ISIN, 2) = "EE" Or Left(ISIN, 2) = "DE" Or Left(ISIN, 2) = "FR" Or Left(ISIN, 2) = "NL" Or Left(ISIN, 2) = "IT" Or Left(ISIN, 2) = "IE" Or Left(ISIN, 2) = "AT" Or Left(ISIN, 2) = "BE" Or Left(ISIN, 2) = "ES" Or Left(ISIN, 2) = "PT") Then 
        Komisija = Summa * 0.002 
        ActiveCell.Value = Komisija 
        End If 
       '(ASV) 
       If klienta_nr = 12 And (Left(ISIN, 2) = "US") Then 
        Komisija = Summa * 0.002 
        End If 
       '(Lielbritānijas) 
       If klienta_nr = 12 And (Left(ISIN, 2) = "UK") Then 
        Komisija = Summa * 0.002 
        ActiveCell.Value = Komisija 
        End If 
       '(Šveices) 
       If klienta_nr = 12 And (Left(ISIN, 2) = "CH") Then 
        Komisija = Summa * 0.002 
        ActiveCell.Value = Komisija 
        End If 
       'Set 20 [valūte] MIN 
       If klienta_nr = 12 And Komisija <= 20 Then 
        ActiveCell.Value = 20 
        End If 


    Case 13 
       '(Ziemeļvastu, Lietuvas, Igaunijas, Vācijas, Francijas, Nīderlandes, Itālijas, Īrijas, Austijas, Beļģijas, Spānijas, Portugāles) 
       If klienta_nr = 13 And (Left(ISIN, 2) = "NO" Or Left(ISIN, 2) = "SE" Or Left(ISIN, 2) = "DK" Or Left(ISIN, 2) = "FI" Or Left(ISIN, 2) = "IS" Or Left(ISIN, 2) = "LT" Or Left(ISIN, 2) = "EE" Or Left(ISIN, 2) = "DE" Or Left(ISIN, 2) = "FR" Or Left(ISIN, 2) = "NL" Or Left(ISIN, 2) = "IT" Or Left(ISIN, 2) = "IE" Or Left(ISIN, 2) = "AT" Or Left(ISIN, 2) = "BE" Or Left(ISIN, 2) = "ES" Or Left(ISIN, 2) = "PT") Then 
        Komisija = Summa * 0.002 
        ActiveCell.Value = Komisija 
        End If 
       '(ASV) 
       If klienta_nr = 13 And (Left(ISIN, 2) = "US") Then 
        Komisija = Summa * 0.002 
        ActiveCell.Value = Komisija 
        End If 
       '(Lielbritānijas) 
       If klienta_nr = 13 And (Left(ISIN, 2) = "UK") Then 
        Komisija = Summa * 0.002 
        ActiveCell.Value = Komisija 
        End If 
       '(Šveices) 
       If klienta_nr = 13 And (Left(ISIN, 2) = "CH") Then 
        Komisija = Summa * 0.002 
        ActiveCell.Value = Komisija 
        End If 
       'Set 20 [valūte] MIN 
       If klienta_nr = 13 And Komisija <= 20 Then 
        ActiveCell.Value = 20 
        End If 


    Case 14 
       '(ASV) 
       If klienta_nr = 14 And (Left(ISIN, 2) = "US") Then 
        Komisija = Summa * 0.0027 
        ActiveCell.Value = Komisija 
        End If 
       'Set 40 USD MIN 
       If klienta_nr = 14 And Komisija <= 40 Then 
        ActiveCell.Value = 40 
        End If 



    'Non-special klient cases 
    Case Else 
      If Not Application.Match(klienta_nr, kSheet.Range("A2:A100")) Then 
       'IP2, 0.03% komisija, 40 EUR/USD Max 
       If Right(vk, 1) = 1 Or Right(vk, 1) = 8 Then 
        Komisija = Summa * 0.003 
        ActiveCell.Value = Komisija 
        End If 
       'IP1, 0.1% komisija, 40 EUR/USD Max 
       If Right(vk, 1) = 7 Then 
        Komisija = Summa * 0.01 
        ActiveCell.Value = Komisija 
        End If 
       'Komisija MAX is 40, so anything >=40 equals 40 
       If Komisija >= 40 Then 
        ActiveCell.Value = 40 
        End If 
      End If 
End Select 
End Sub 
+1

Das erste Problem: Sie schrieb eine 'Funktion', aber diese Routine hat keinen Rückgabewert. In Anbetracht dessen, was es auf den ersten Blick zu tun scheint, sollte es nicht ein "Sub" sein? Sie ändern den 'ActiveCell.value' - eine Funktion sollte nur einen Rückgabewert haben, so dass, wenn es aufgerufen wird, Sie' ActiveCell.Value = yourfunction (parameters) ' –

+0

Ich sehe keinen zirkulären Referenzfehler in der Code selbst - Sicherlich machen Sie es in ein "sub". Werfen Sie auch einen Blick auf [Wie zu vermeiden, wählen/aktivieren] (https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) –

+0

Making it a Sub tut Arbeit. Wenn ich die Provisionen für mehrere Zeilen mit Daten aus jeder Zeile berechnen möchte, wie soll ich die Variablen zuweisen? – Nikolajs

Antwort

0

so etwas wie dieses Versuchen:

eine Auswahl überall in dem Blatt Stellen und Ihre Sub Schleife über jede Zeile machen, die in der aktuellen Auswahl ist.

Sub komisija_calc(klienta_nr As Double) 

'Declare the variables 
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 x As Integer 

Dim rng As Range 'Added variable 

Application.ScreenUpdating = False 
Set kSheet = ThisWorkbook.Sheets("komisijas") 
'Getting rid off Worksheets("Order Machine").Activate 

'Set variables equal to the cell data 
'We'll loop over the rows in the selection instead of what you did: 
'Maybe add a check to ensure the selection is only one column, otherwise you'll do more loops than neccessary: 

For Each rng In Selection 'START LOOP! - Selection is still bad - you might want to get your rows in another way, the loop is for demonstration purposes. 
    With Worksheets("Order Machine") 
     ISIN = .Range("E" & rng.Row).Value 
     Cena = .Range("H" & rng.Row).Value 
     Skaits = .Range("I" & rng.Row).Value 
     vk = .Range("B" & rng.Row).Value 
     Summa = Cena * Skaits 

     '----------- 
     'Start Cases 
     '----------- 
     Select Case klienta_nr 
     'Special klient cases 
     '... all your code here... 
      .Range("A" & rng.Row).Value = Komisija 'To put the commission in column A of "Order Machine" worksheet. Change as needed. 
     End Select 
    End With 
Next rng 'Next row in selection. 
End Sub 

Edit: Ich nehme an, Sie wollen, dass die „aktuelle Zeile“ der Active/die aktuelle Auswahl gleich sein. Sie müssen dann nur ersetzen:

klienta_nr = Range("B2").Value 
ISIN = Range("E2").Value 
Cena = Range("H2").Value 
Skaits = Range("I2").Value 
vk = Range("D2").Value 
Summa = Cena * Skaits 

mit:

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

Ich gehe davon aus, dass Ihr ActiveCell auf dem gleichen Arbeitsblatt wie diese Eingabewerte ist, wenn Sie diesen Makro ausführen? Angenommen, Ihre aktive Zelle ist "S5", dann wird klienta_nr von Zelle "B5" genommen.

Ich kann nicht genug betonen, dass Sie wirklich zu vermeiden, sollten versuchen, .Activate verwenden, ActiveCell, Selection, etc. etc.

+0

Vielen Dank dafür, aber es scheint immer noch nicht zu funktionieren. Ich hatte es vorher funktioniert, aber es würde nur die Kommission für eine Reihe zurückgeben. Ich möchte es haben, damit es die Kommission der Werte jeder Reihe zurückbringen kann. Ich kann meinen Code für mein zuvor arbeitendes Sub posten. – Nikolajs

+0

Bitte bearbeiten Sie die Frage in der Tat, ich werde die Antwort umschreiben. –

+0

Bearbeiteter Code in Frage – Nikolajs

0

Wenn Sie eine VBA-Funktion schreiben, die eine Form Arbeitsblatt-Zelle aufgerufen werden muss (auch wissen, Als eine benutzerdefinierte Funktion) MÜSSEN Sie sicherstellen, dass ALLE Zellen, die die Funktion benötigt, als Argumente übergeben werden. Also (ohne Ihren Code zu optimieren), ich denke, das ist, was funktionieren sollte:

Function komisija_calc(klienta_nr As Double, ISIN As String, Cena As Double, _ 
         Skaits As Double, Vk As String, ClientNumbers As Range) 

'Declare the variables 
    Dim Komisija As Double 
    Dim Summa As Double 

    'Set variables equal to the cell data 
    '----------------------------------------------------------- 
    'I NEED TO SET THESE TO BE EQUAL TO THE CURRENT ROW'S VALUES 
    '----------------------------------------------------------- 
    Summa = Cena * Skaits 


    '-------------------------------------------------------------------------- 
    'Loop through Column A until blank 
    '------------------------------------------------------------------------- 


    '--------------------------------------------------------------------------------------------- 
    'Start Cases 
    '--------------------------------------------------------------------------------------------- 
    Select Case klienta_nr 

     'Special klient cases 


    Case 10 
     '(Vacija, Francija, Niderlandes, Italija, Irija) - 30 EUR MIN 
     If klienta_nr = 10 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 
      komisija_calc = Komisija 
     End If 
     If klienta_nr = 10 And Komisija <= 30 Then 
      komisija_calc = 30 
     End If 

     'Case where klient is special, but ISIN doesn't apply 
     If klienta_nr = 10 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 
       komisija_calc = 40 
      End If 
     End If 


    Case 11 
     '(Vacija, Francija, Niderlandes, Italija, Irija) - 30 EUR MIN 
     If klienta_nr = 11 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 
      komisija_calc = Komisija 
     End If 
     'Set 30 EUR Min 
     If klienta_nr = 11 And Komisija <= 30 Then 
      komisija_calc = 30 
     End If 

     'End If 


    Case 12 
     '(Ziemelvastu, Lietuvas, Igaunijas, Vacijas, Francijas, Niderlandes, Italijas, Irijas, Austijas, Belgijas, Spanijas, Portugales) 
     If klienta_nr = 12 And (Left(ISIN, 2) = "NO" Or Left(ISIN, 2) = "SE" Or Left(ISIN, 2) = "DK" Or Left(ISIN, 2) = "FI" Or Left(ISIN, 2) = "IS" Or Left(ISIN, 2) = "LT" Or Left(ISIN, 2) = "EE" Or Left(ISIN, 2) = "DE" Or Left(ISIN, 2) = "FR" Or Left(ISIN, 2) = "NL" Or Left(ISIN, 2) = "IT" Or Left(ISIN, 2) = "IE" Or Left(ISIN, 2) = "AT" Or Left(ISIN, 2) = "BE" Or Left(ISIN, 2) = "ES" Or Left(ISIN, 2) = "PT") Then 
      Komisija = Summa * 0.002 
      komisija_calc = Komisija 
     End If 
     '(ASV) 
     If klienta_nr = 12 And (Left(ISIN, 2) = "US") Then 
      Komisija = Summa * 0.002 
     End If 
     '(Lielbritanijas) 
     If klienta_nr = 12 And (Left(ISIN, 2) = "UK") Then 
      Komisija = Summa * 0.002 
      komisija_calc = Komisija 
     End If 
     '(Šveices) 
     If klienta_nr = 12 And (Left(ISIN, 2) = "CH") Then 
      Komisija = Summa * 0.002 
      komisija_calc = Komisija 
     End If 
     'Set 20 [valute] MIN 
     If klienta_nr = 12 And Komisija <= 20 Then 
      komisija_calc = 20 
     End If 


    Case 13 
     '(Ziemelvastu, Lietuvas, Igaunijas, Vacijas, Francijas, Niderlandes, Italijas, Irijas, Austijas, Belgijas, Spanijas, Portugales) 
     If klienta_nr = 13 And (Left(ISIN, 2) = "NO" Or Left(ISIN, 2) = "SE" Or Left(ISIN, 2) = "DK" Or Left(ISIN, 2) = "FI" Or Left(ISIN, 2) = "IS" Or Left(ISIN, 2) = "LT" Or Left(ISIN, 2) = "EE" Or Left(ISIN, 2) = "DE" Or Left(ISIN, 2) = "FR" Or Left(ISIN, 2) = "NL" Or Left(ISIN, 2) = "IT" Or Left(ISIN, 2) = "IE" Or Left(ISIN, 2) = "AT" Or Left(ISIN, 2) = "BE" Or Left(ISIN, 2) = "ES" Or Left(ISIN, 2) = "PT") Then 
      Komisija = Summa * 0.002 
      komisija_calc = Komisija 
     End If 
     '(ASV) 
     If klienta_nr = 13 And (Left(ISIN, 2) = "US") Then 
      Komisija = Summa * 0.002 
      komisija_calc = Komisija 
     End If 
     '(Lielbritanijas) 
     If klienta_nr = 13 And (Left(ISIN, 2) = "UK") Then 
      Komisija = Summa * 0.002 
      komisija_calc = Komisija 
     End If 
     '(Šveices) 
     If klienta_nr = 13 And (Left(ISIN, 2) = "CH") Then 
      Komisija = Summa * 0.002 
      komisija_calc = Komisija 
     End If 
     'Set 20 [valute] MIN 
     If klienta_nr = 13 And Komisija <= 20 Then 
      komisija_calc = 20 
     End If 


    Case 14 
     '(ASV) 
     If klienta_nr = 14 And (Left(ISIN, 2) = "US") Then 
      Komisija = Summa * 0.0027 
      komisija_calc = Komisija 
     End If 
     'Set 40 USD MIN 
     If klienta_nr = 14 And Komisija <= 40 Then 
      komisija_calc = 40 
     End If 



     'Non-special klient cases 
    Case Else 
     If Not Application.Match(klienta_nr, ClientNumbers) Then 
      'IP2, 0.03% komisija, 40 EUR/USD Max 
      If Right(Vk, 1) = 1 Or Right(Vk, 1) = 8 Then 
       Komisija = Summa * 0.003 
       komisija_calc = Komisija 
      End If 
      'IP1, 0.1% komisija, 40 EUR/USD Max 
      If Right(Vk, 1) = 7 Then 
       Komisija = Summa * 0.01 
       komisija_calc = Komisija 
      End If 
      'Komisija MAX is 40, so anything >=40 equals 40 
      If Komisija >= 40 Then 
       komisija_calc = 40 
      End If 
     End If 
    End Select 
End Function