VBA Sub来计算所有的行
我有一个VBA程序的工作代码，根据他/她的情况返回一个客户的佣金，但是我只能计算一个客户。
在我的Excel表格中，每行都有特定的数据，如图所示。 
我怎样才能改变这个代码，让它一次计算多行？
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 'Application.ScreenUpdating = False Set kSheet = ThisWorkbook.Sheets("spec_klienti") klienta_nr = Range("B2").Value ISIN = Range("E2").Value Cena = Range("H2").Value Skaits = Range("I2").Value vk = Range("D2").Value Summa = Cena * Skaits 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 这是一个很好的开始。 在列5中写入一些值并逐步运行此代码：
Option Explicit Public Sub TestMe() Dim lngFirstRow As Long: lngFirstRow = 1 Dim lngLastRow As Long Dim lngCol As Long: lngCol = 5 Dim lngCounter As Long With Worksheets(1) lngLastRow = .Cells(.Rows.Count, lngCol).End(xlUp).Row For lngCounter = lngFirstRow To lngLastRow .Cells(lngCounter, lngCol) = lngCounter + lngCol 'here should come more business logic Next lngCounter End With End Sub
它会告诉你如何遍历电子表格中的行。 然后，你可以在循环中添加代码，使其可行（我写的地方“这里应该来更多的业务逻辑”）。 一般来说，这就够了。
我会推荐以下内容： – 查找表单中的最后一行 – 遍历每一行并进行计算
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 lastrow As Long Dim i As Long 'Application.ScreenUpdating = False Set kSheet = ThisWorkbook.Sheets("spec_klienti") With kSheet lastrow = .Cells(.Rows.count, cln).End(xlUp).Row End With for i = 2 to lastrow klienta_nr = Range("B"&i).Value ISIN = Range("E"&i).Value Cena = Range("H"&i).Value Skaits = Range("I"&i).Value vk = Range("D"&i).Value Summa = Cena * Skaits 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 Next i End Sub