Fejl ?
Jeg skal lave et program der løber en medlemsliste igennem , og finder de medlemmer der har fejl i deres cpr-nummer, og dernæst overfører dem til en fejlliste.Jeg har lavet et nogenlunde program, men det vil ikke køre som jeg vil :) Det finder alt for mange format fejl .
Min kode er godt nok en smule rodet, men hvis nogen kan finde fejlen, ville jeg blive meget glad :)
Her er koden :
Public Sub Ny()
Dim i As Integer
Dim Countrows As Integer
Dim CPR As String
Dim Fejlcpr As Integer
Dim ark1 As Range
Dim ark2 As Range
'Alle tegn i cpr-nummeret:
Dim A1 As Integer
Dim B2 As Integer
Dim C3 As Integer
Dim D4 As Integer
Dim E5 As Integer
Dim F6 As Integer
Dim G As Single
Dim H7 As Integer
Dim I8 As Integer
Dim J9 As Integer
Dim K10 As Integer
Dim Modulus11 As Long
Dim bFejl As Boolean
Dim bKorrekt As Boolean
'De to ark sættes således at de kan refereres til
'vha ark1 og ark2:
Set ark1 = ThisWorkbook.Sheets("Medlemskartotek").Range("A2")
Set ark2 = ThisWorkbook.Sheets("Fejlliste").Range("A2")
'Tæller hvor mange cpr-numre der står i rækken:
Countrows = ark1.CurrentRegion.Rows.Count - 1
'Hvis tegn nr. 7 ikke er lig med "-" er cpr-nummeret forkert:
If Mid(CPR, 7, 1) <> "-" Then
bFejl = True
End If
'Hvis de første 6 tegn ikke er tal:
bFejl = Not IsNumeric(Left(CPR, 6))
'Hvis de sidste 4 tegn ikke er tal:
bFejl = Not IsNumeric(Right(CPR, 4))
'Alle bFejl tælles til fejllisten:
If bFejl = True Then
Fejlcpr = Fejlcpr + 1
End If
'Cpr-nummeret er kun korrekt i dette format:
bKorrekt = CPR Like "######-####"
'Alle bKorrekt der er ukorrekte, tælles med:
If bKorrekt = False Then
Fejlcpr = Fejlcpr + 1
End If
'Værdierne for bFejl og bKorrekt sættes ind i fejllisten
With ark1
For i = 1 To Countrows
CPR = .Offset(i, 0)
ark2.Offset(Fejlcpr, 0) = CPR
ark2.Offset(Fejlcpr, 1) = ark1.Offset(i, 1)
ark2.Offset(Fejlcpr, 2) = ark1.Offset(i, 2)
ark2.Offset(Fejlcpr, 3) = ark1.Offset(i, 3)
ark2.Offset(Fejlcpr, 4) = ark1.Offset(i, 4)
ark2.Offset(Fejlcpr, 5) = ark1.Offset(i, 5)
ark2.Offset(Fejlcpr, 6) = "Cpr-nummeret har et forkerkt format"
'Hvis cpr-nr. cellen er tom, sættes medlemmernes værdier ind i fejllisten:
If CPR = "" Then
Fejlcpr = Fejlcpr + 1
ark2.Offset(Fejlcpr, 0) = CPR
ark2.Offset(Fejlcpr, 1) = ark1.Offset(i, 1)
ark2.Offset(Fejlcpr, 2) = ark1.Offset(i, 2)
ark2.Offset(Fejlcpr, 3) = ark1.Offset(i, 3)
ark2.Offset(Fejlcpr, 4) = ark1.Offset(i, 4)
ark2.Offset(Fejlcpr, 5) = ark1.Offset(i, 5)
ark2.Offset(Fejlcpr, 6) = "Mangler et Cpr-nummer"
Else
'Dernæst testes for modulus 11-check, som udregnes vha en formel:
'Alle tal, samt stregen efter det 6. tal defineres:
A1 = Mid(CPR, 1, 1)
B2 = Mid(CPR, 2, 1)
C3 = Mid(CPR, 3, 1)
D4 = Mid(CPR, 4, 1)
E5 = Mid(CPR, 5, 1)
F6 = Mid(CPR, 6, 1)
H7 = Mid(CPR, 8, 1)
I8 = Mid(CPR, 9, 1)
J9 = Mid(CPR, 10, 1)
K10 = Mid(CPR, 11, 1)
'Der testes om modulus 11 check er opfyldt:
Modulus11 = (4 * A1) + (3 * B2) + (2 * C3) + (7 * D4) + (6 * E5) + (5 * F6) + (4 * H8) + (3 * I9) + (2 * J10)
End If
'Hvis modulus 11 ikke opfyldes, overføres værdien til fejllisten:
If Modulus11 <> 11 Then
Fejlcpr = Fejlcpr + 1
ark2.Offset(Fejlcpr, 0) = CPR
ark2.Offset(Fejlcpr, 1) = ark1.Offset(i, 1)
ark2.Offset(Fejlcpr, 2) = ark1.Offset(i, 2)
ark2.Offset(Fejlcpr, 3) = ark1.Offset(i, 3)
ark2.Offset(Fejlcpr, 4) = ark1.Offset(i, 4)
ark2.Offset(Fejlcpr, 5) = ark1.Offset(i, 5)
ark2.Offset(Fejlcpr, 6) = "Modulus 11 fejl"
End If
Next
End With
End Sub
