11. marts 2015 - 15:39Der er
4 kommentarer og 1 løsning
Kontrol af MAC-adresse format
Jeg har et regneark, hvor den ene kolonne indeholder mac-adresser på flg. format 12:34:56:78:9A:BC Er der nogen der kan hjælpe med en makro, der gør følgende: 1) Kontrollerer, at der er 17 tegn i cellen 2) At hvert 3. tegn er et : 3) At der kun er brugt hexadecinale tal (1,2,3,4,5,6,7,8,9,A,B,C,D,E,F) Der er ingen garanti for, at der er brugte store bogstaver 4) At der ikke er 2 ens mac-adresser i listen
Makroen skal markere en evt. fejlbehæftet celle og skrive hvilken fejl, der er fundet i cellen.
Sub CheckMAC() Dim c As Range Range("A1:A15").ClearFormats For Each c In Range("A1:A15") c.Offset(0, 1) = "" If Application.WorksheetFunction.CountIf(Range("A1:A15"), c) > 1 Then c = "" GoTo A: End If c = UCase(c) If Len(c) <> 17 Then c.Offset(, 1) = "MAC adressen skal være 17 karakterer lang" End If For x = 1 To 17 Y = Mid(c, x, 1) Select Case x Case 1, 2, 4, 5, 7, 8, 10, 11, 13, 14, 16, 17 If IsNumeric(Y) Or Y = "A" Or Y = "B" Or Y = "C" Or Y = "D" Or Y = "E" Or Y = "F" Then Else c.Offset(0, 1) = " Der må kun bruges tal og ABCDEF i MAC adressen" With c.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With End If Case 3, 6, 9, 12, 15 If Y <> ":" Then c.Offset(0, 1) = " Der skal være kolon på hver 3. plads i Mac adressen" With c.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With End If End Select Next A: Next End Sub
Tak for et god forslag. Jeg har arbejdet lidt videre på det, så kontrollen foregår inden for en afmærket række data. Jeg kan dog ikke finde ud af at få ændret denne linje, så den kikker efter dubletter i det markerede område i stedet for A1:A15
If Application.WorksheetFunction.CountIf(Range("A1:A15"), c) > 1 Then
Det kunne også være rart, at der kom en messagebox, hvis der ikke var markeret noget i regnearket, når man kalder makroen.
Makroen ser således ud nu:
Sub CheckMAC() Dim c As Range Dim myRange As Range Set myRange = Selection myRange.ClearFormats For Each c In myRange c.Offset(0, 1) = "" 'Find dubletter If Application.WorksheetFunction.CountIf(Range("A1:A15"), c) > 1 Then c.Offset(, 1) = " Denne adresse er dubleret" With c.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With GoTo A: End If c = UCase(c) If Len(c) <> 17 Then c.Offset(, 1) = " MAC adressen skal være 17 karakterer lang" With c.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With GoTo A: End If For x = 1 To 17 Y = Mid(c, x, 1) Select Case x Case 1, 2, 4, 5, 7, 8, 10, 11, 13, 14, 16, 17 If IsNumeric(Y) Or Y = "A" Or Y = "B" Or Y = "C" Or Y = "D" Or Y = "E" Or Y = "F" Then Else c.Offset(0, 1) = " Der må kun bruges hexadecimale tal i MAC adressen" With c.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With GoTo A: End If Case 3, 6, 9, 12, 15 If Y <> ":" Then c.Offset(0, 1) = " Der skal være kolon på hver 3. plads i Mac adressen" With c.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With GoTo A: End If End Select Next A: Next
Her er den færdige kode til kontrol af MAC-adresser i et dynamisk markeret område:
Sub CheckMAC() Dim c As Range Dim myRange As Range Dim SelectedRange As String Set myRange = Selection SelectedRange = myRange.Cells(1).Address(0, 0) + ":" + myRange.Cells(myRange.Rows.Count, 1).Address(0, 0) myRange.ClearFormats If Selection.Count < 2 Then MsgBox ("Du skal markere de celler, der skal kontrolleres!") Exit Sub End If For Each c In myRange c.Offset(0, 2) = "" 'Find dubletter If Application.WorksheetFunction.CountIf(Range(SelectedRange), c) > 1 Then c.Offset(, 1) = " Denne adresse er dubleret" With c.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With GoTo A: End If c = UCase(c) If Len(c) <> 17 Then c.Offset(, 2) = " MAC adressen skal være 17 karakterer lang" With c.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With GoTo A: End If For x = 1 To 17 Y = Mid(c, x, 1) Select Case x Case 1, 2, 4, 5, 7, 8, 10, 11, 13, 14, 16, 17 If IsNumeric(Y) Or Y = "A" Or Y = "B" Or Y = "C" Or Y = "D" Or Y = "E" Or Y = "F" Then Else c.Offset(0, 2) = " Der må kun bruges hexadecimale tal i MAC adressen" With c.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With GoTo A: End If Case 3, 6, 9, 12, 15 If Y <> ":" Then c.Offset(0, 2) = " Der skal være kolon på hver 3. plads i Mac adressen" With c.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With GoTo A: End If End Select Next A: Next MsgBox ("Cellerne i området " & SelectedRange & " er kontrolleret nu!") End Sub
Tak til Jens48 for stor hjælp. @Jens48 Læg et svar og du får dine point.
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
