03. marts 2010 - 10:15Der er
11 kommentarer og 1 løsning
Dynamisk område for datavalidering Excel/VB
Hej
Jeg arbejder på et excelark, hvor bruger indtaster oplysninger i cellerne A5:Fx. X-betyder at brugeren kan indtaste x antal linier. I kolonnerne A til F skal brugeren indtaste alle værdier og ikke undlade nogen information. Til dette vil jeg bruge datavalidering, men da det er på et dynamisk område har jeg problemer med at få min kode til at søge direkte det definerede område.
' Overfør_data Makro '
' Dim RK1 As Long Dim x As Long Dim Blank As Long With ThisWorkbook.Sheets("Ark1") RK1 = .Range("A65536").End(xlUp).Row End With
Set x = Range("A5:F" & RK1) For Each Celle In x.Cells If Celle = "" Then Blank = MsgBox(prompt:="Du mangler at indtaste oplysninger!", Title:="Meddelelse", Buttons:=vbInformation) End If
Sub Overfør_data() Dim RK1 As Long Dim x As Long Dim Blank As Long
With ThisWorkbook.Sheets("Ark1") RK1 = .Range("A65536").End(xlUp).Row End With
Range("A5:F" & CStr(RK1)).Select
For Each Celle In Selection.Cells If Celle = "" Then Blank = MsgBox(prompt:="Du mangler at indtaste oplysninger!", Title:="Meddelelse", Buttons:=vbInformation) End If Next
Rem verson 2 Sub Overfør_data() Dim RK1 As Long Dim x As Long Dim Blank As Long Dim antalTomme As Byte
With ThisWorkbook.Sheets("Ark1") RK1 = .Range("A65536").End(xlUp).Row End With
Range("A5:F" & CStr(RK1)).Select
antalTomme = 0
For Each celle In Selection.Cells If celle = "" Then antalTomme = antalTomme + 1 celle.Interior.ColorIndex = 3 Else celle.Interior.ColorIndex = xlColorIndexNone End If Next
If antalTomme > 0 Then Blank = MsgBox(prompt:="Du mangler at indtaste oplysninger!", Title:="Meddelelse", Buttons:=vbInformation) End If End Sub
Jeg har dog lige en ting, som jeg ikke havde med i tankerne tidligere. Hvis brugeren ikke har indtastet informationer i kolonne A, men i B, C, D, E eller F tager dette skriv ikke højde for det:
With ThisWorkbook.Sheets("Ark1") RK1 = .Range("A65536").End(xlUp).Row End With
Kan man ændre skrivet til at RK1 defineres som det højest rækkenummer i kolonnerne A til F?
Rem verson 3 Sub Overfør_data() Dim RK1 As Long Dim x As Long Dim Blank As Long Dim antalTomme As Byte
With ThisWorkbook.Sheets("Ark1") RK1 = ActiveCell.SpecialCells(xlLastCell).Row End With
Range("A5:F" & CStr(RK1)).Select
antalTomme = 0
For Each celle In Selection.Cells If celle = "" Then antalTomme = antalTomme + 1 celle.Interior.ColorIndex = 3 Else celle.Interior.ColorIndex = xlColorIndexNone End If Next
If antalTomme > 0 Then Blank = MsgBox(prompt:="Du mangler at indtaste oplysninger!", Title:="Meddelelse", Buttons:=vbInformation) End If End Sub
Der er bare et problem at datavalideringen ikke nulstilles efter makroen er kørt.
Hvis bruger 1 indtaster data i rækkerne A5-F18, vil næste bruger 2, som indtaster data i rækkerne A5-F13 få røde celler og besked om at indtaste data i rækkerne A14-F18.
Så skal rækker slettes på et eller andet tidspunkt.
PS: For en god ordens skyld - når du svarer - så send som Kommentar og ikke Svar. Svar ert forbeholdt den/de, der sender forslag som Kommentar eller løsning som Svar på problemet.
Suppler evt. med følgende - evt. forbind med en knap eller anden handling:
Sub sletFraRække5() With ThisWorkbook.Sheets("Ark1") RK1 = ActiveCell.SpecialCells(xlLastCell).Row
.Range("A5:F" & CStr(RK1)).Select Selection.Delete End With End Sub
Synes godt om
Ny brugerNybegynder
Din løsning...
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.
