Repetera makro i vba

[Tudor]

Jag ska ta fram 250 nummer med checksifferberäkning. Jag har macrot för checksiffran, men den hämtar bara värdet i en cell och visar checksiffran i en annan. Jag vill skriva min nummerserie och och få makron att beräkna samtliga checksiffror. dvs strDeltagarnummer = c5:c255 typ 

 

tack för all hjälp

 

Sub Checksiffra()

 

strDeltagarnummer = Trim(Range("C5").Text)  

 

strSiffra_1 = Left(strDeltagarnummer, 1)

strSiffra_2 = Mid(strDeltagarnummer, 2, 1)

strSiffra_3 = Mid(strDeltagarnummer, 3, 1)

strSiffra_4 = Mid(strDeltagarnummer, 4, 1)

strSiffra_5 = Mid(strDeltagarnummer, 5, 1)

strSiffra_6 = Mid(strDeltagarnummer, 6, 1)

 

strSiffra_1 = strSiffra_1 * 2

strSiffra_2 = strSiffra_2 * 1

strSiffra_3 = strSiffra_3 * 2

strSiffra_4 = strSiffra_4 * 1

strSiffra_5 = strSiffra_5 * 2

strSiffra_6 = strSiffra_6 * 1

 

If strSiffra_1 >= 10 Then strSiffra_1 = 1 + Mid(strSiffra_1, 2, 1) Else _ strSiffra_1 = Left(strSiffra_1, 1) + Mid(strSiffra_1, 2, 1)

If strSiffra_2 >= 10 Then strSiffra_2 = 1 + Mid(strSiffra_2, 2, 1) Else _ strSiffra_2 = Left(strSiffra_2, 1) + Mid(strSiffra_2, 2, 1)

If strSiffra_3 >= 10 Then strSiffra_3 = 1 + Mid(strSiffra_3, 2, 1) Else _ strSiffra_3 = Left(strSiffra_3, 1) + Mid(strSiffra_3, 2, 1)

If strSiffra_4 >= 10 Then strSiffra_4 = 1 + Mid(strSiffra_4, 2, 1) Else _ strSiffra_4 = Left(strSiffra_4, 1) + Mid(strSiffra_4, 2, 1)

If strSiffra_5 >= 10 Then strSiffra_5 = 1 + Mid(strSiffra_5, 2, 1) Else _ strSiffra_5 = Left(strSiffra_5, 1) + Mid(strSiffra_5, 2, 1)

If strSiffra_6 >= 10 Then strSiffra_6 = 1 + Mid(strSiffra_6, 2, 1) Else _ strSiffra_6 = Left(strSiffra_6, 1) + Mid(strSiffra_6, 2, 1)

 

strKontrollSumma = strSiffra_1 + strSiffra_2 + strSiffra_3 + _ strSiffra_4 + strSiffra_5 + strSiffra_6

 

strKontrollSiffra = 10 - strKontrollSumma Mod 10  

 

If strKontrollSiffra = 10 Then strKontrollSiffra = 0

 

Range("D5") = strKontrollSiffra      

99:

End Sub

[Monshi]

Du kan annars skapa denna som en funktion och använda den som vilken annan funktion som helst i bladet.

Fast är kanske inte den väg du önskar gå.

 

Repetera något. Grunden kan vara att skriva om två rader i det ovan:

Function Checksiffra(rn As Range)
   strDeltargarnummer = Trim(rn.Text)
   ...
   ...
   Checksiffra = strKontrollSiffra
End Function

Sedan skapar du en annan funktion som loopar över cellerna och tar hand om checksumman du skapar.

Exempelvis

Sub myrunner()

    Dim rn As Range
    Dim c As Range
    Set rn = Blad1.Range("a1:a5")
    For Each c In rn
        c.offsett(0, 1) = checksiffra(c)
    Next c

End Sub

Eller om du har funktionen checksiffra i en modul kan du på ett blad, i en cell, skirva

=checksiffra(a1)

och den kommer räkna ut den.
Kanske inte  lämpligt då din funktion är tämligen komplex och kan ta tid att beräkna om den finns i många celler men testa.

 

 

Ed: ett litet slarvfel fixat i sista koden

[Tudor]

Tackar jag testar