Opgelost Controleer celinhoud op 3 criteria

  • Onderwerp starter Onderwerp starter keb
  • Startdatum Startdatum
Dit topic is als opgelost gemarkeerd

keb

Gebruiker
Lid geworden
20 feb 2011
Berichten
174
In tientallen tabbladen staan codes die ik op 3 criteria moet controleren:
a) de code moet minimaal 3 en maximaal 6 karakters lang zijn
b) de code moet beginnen met de letters a t/m f
c) de karakters 2 t/m het einde moeten een getal vormen.

Ik loop vast op het samenstellen van van de criteria.
C++:
Sub Controleer()
'
' Controleer geldigheid van code
'   1. Code moet 3 t/m 6 tekens lang zijn
'   2. Eerste karakter moet a t/m f (of A t/m F) zijn
'   3. Karakters twee t/m de laatste moet een geldig getal zijn

Dim cell As Range
Dim ws As Worksheet
Dim rng As Range
Dim row1 As Integer

row1 = 2:

Application.ScreenUpdating = False

On Error Resume Next
'Dim strText As String
'strText = "f1057"
'MsgBox Len(strText)
'MsgBox InStr(1, "ABCDEabcef", Left(strText, 1), vbTextCompare)
'MsgBox InStr("ABCDEabcef", Left(strText, 1))
'If (InStr("ABCDEabcef", Left(strText, 1)) > 0) Then MsgBox "Hoera"

'If (Len(strText) >= 3 And Len(strText) <= 6) And (InStr("ABCDEabcef", Left(strText, 1), vbTextCompare) > 0) Then
'    MsgBox strText & "    Raak"
'    End If
        

For Each ws In ActiveWorkbook.Worksheets
    ws.Activate

    For Each cell In ws.UsedRange
        
        If (Len(cell.Value) >= 3 And Len(cell.Value) <= 6) Then       'Voorwaarde 1  Lengte mag van 3 tot 6 lopen
            'MsgBox cell.Value & "   3 t/m 6 tekens"
            If (InStr("ABCDEabcef", Left(cell.Value, 1)) > 0) Then    'Voorwaarde 2  Eerste letter moet A t/m f zijn
                MsgBox ActiveCell & "    " & activeSheetname
                If IsNumeric(Mid(cell.Value, 2)) Then                 'Voorwaarde 3  Cijfers 2 t/m 5 moeten een getal vormen
                    'Zet een controlevinkje in kolom 3
                    Cells(cell.Row, 3) = "v"
                    End If
            End If
          End If
            
        Next  'Cell
    Next 'sheet

    
    Application.ScreenUpdating = True
    MsgBox "Klaar"
End Sub
 

Bijlagen

In de nieuwere versies kan het met regex
Code:
=REGEXTEST(a1, "^[A-Fa-f]{1}\d{2,5}$")
 
Ahulpje, superbedankt!
Slim trucje met Ucase
 
1 regel lijkt mij voldoende: als goed >0 , als fout 0

Code:
it="F12345"
InStr("ABCDEF", UCase(Left(it, 1))) * (Mid(it, 2) < 10 ^ 5) * (Mid(it, 2) > 9)

Een test:
Code:
Sub M_snb()
     sn = Array("F12345", "F123456", "F12", "F2", "G12345")
    
     For Each it In sn
        MsgBox InStr("ABCDEF", UCase(Left(it, 1))) * (Mid(it, 2) < 10 ^ 5) * (Mid(it, 2) > 9), , it
     Next
End Sub

Als Excelformule:

Code:
=(LEN(SUBSTITUTE("ABCDEF";LEFT(B3;1);""))=5)*(--MID(B3;2;LEN(B3))<10^5)*(--MID(B3;2;LEN(B3))>9)
 
Laatst bewerkt:
Terug
Bovenaan Onderaan