• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Visual Basic

Status
Niet open voor verdere reacties.
N

nielsbl11

Gebruiker
Lid geworden
26 sep 2012
Berichten
98
Kan iemand mij helpen met het opzetten van een code in visual basic,
Ik heb zelf al het een en ander geprobeerd:

Visual Basic moet kijken of de cellen (in excel) B7,8,9,20,24 leeg zijn, dit mag namelijk niet zo zijn. Hij moet daarna in excel E5 aangeven dat er iets niet goed gaat. Als het kan ook de cellen die niet goed zijn, en deze eventueel rood inkleuren.


Code: 
Private Sub CommandButton1_Click()

Dim aantal As Integer, goed As String, fout As String
aantal = 0

If [B7] = "" Then aantal + 1
Else: Next

If [B8] = "" Then aantal + 1
Else: Next

If [B9] = "" Then aantal +1
Else: Next

If [B20] = "" Then aantal + 1
Else: Next

If [B24] = "" Then aantal + 1
Else: Next

goed = "Geen fouten gevonden"
fout = "Foutmeldingen gevonden"

If fout.Value = 0 Then
Range("E5").Value = goed
Else: Range("E5").Value = fout
and MsgBox " aantal LEGE CELLEN GEVONDEN"
 
zoiets

Code: 
Sub test()
For Each cl In Range("b7:b9,b20,b24")
If cl.Value = "" Then
cl.Interior.Color = vbRed
c01 = c01 & "," & cl.Address
End If
Next
If c01 <> "" Then
msg = "Cel " & c01 & " is niet ingevuld."
MsgBox msg
Range("E5").Value = msg
End If
End Sub

Niels
 
Zie je hier iets in?

Code: 
Private Sub CommandButton1_Click()
Dim cl As Range
 fout = 0
 Range("B7:B9, B20, B24").Interior.ColorIndex = xlNone
   For Each cl In Range("B7:B9, B20, B24")
     If IsEmpty(cl) = True Then cl.Interior.ColorIndex = 3: fout = 1
   Next
If fout = 1 Then [E5] = "Fout": MsgBox "Er zijn lege cellen"
End Sub

Alweer te laat! :)
 
Laatst bewerkt:
de code van niels 28 doet zijn werk super!

een aanvullende vraag nog
kan visual basic in kolom A1 tot A400 zoeken naar AC04_02 en dan aangeven welke rij deze staat

Zodat hij in plaats van B7 de rij aangeeft waar AC04_02 in staat en voor B9 AA01_02 enzv
For Each cl In Range("b7:b9,b20,b24")
 
Eventueel nog een fout afhandeling toevoegen want de macro gaat mis as de waarde niet in kolom A voorkomt.

Code: 
Sub test()
For i = 1 To 2 'aanpassen aan je aantal voorwaarden
Set cl = Sheets(1).Range("a1:a400").Find(Choose(i, "AC04_02", "AA01_02"), lookat:=xlWhole).Offset(, 1) 'aanvullen met jouw voorwaarden
If cl.Value = "" Then
cl.Interior.Color = vbRed
c01 = c01 & "," & cl.Address
End If
Next


If c01 <> "" Then
msg = "Cel " & c01 & " is niet ingevuld."
MsgBox msg
Range("E5").Value = msg
End If
End Sub


Niels
 
Laatst bewerkt:
foutmelding 91

Deze cel wordt geel
Code: 
 Set cl = Sheets(1).Range("a1:a400").Find(Choose(i, "AC04_02", "AA01_02"), lookat:=xlWhole).Offset(, 1) 'aanvullen met jouw voorwaarden
 
Klopt de tekst in kolom A dan wel, bij mij werkt het met de opgegeven info.
gaat het ook om het eerste blad?

zie bijlage
Bekijk bijlage zoeken nielsbl11.xlsm

mocht de te zoeken tekst uit een formule komen past dan de volgende code toe

Code: 
Set cl = Sheets(1).Range("a1:a400").Find(Choose(i, "AC04_02", "AA01_02"), [COLOR="#FF0000"]LookIn:=xlValues[/COLOR], lookat:=xlWhole).Offset(, 1)

Niels
 
Laatst bewerkt:
verwacht lijstscheidingsteken of )
en hij selecteerd AA01_02

Code: 
Private Sub CommandButton1_Click()
For i = 1 To 13 'aanpassen aan je aantal voorwaarden
Set cl = Sheets(Leaflet).Range("a1:a400").Find(Choose(i, "AA01_01" "AA01_02" "AA01_03" "AA01_04" "AA01_05" "AA01_06" "AA01_07" "AA01_08" "AA01_09" "AB01_01", "AB01_02" "AB01_04" "AB01_06"), lookat:=xlWhole).Offset(, 1) 'aanvullen met jouw voorwaarden
If cl.Value = "" Then
cl.Interior.Color = vbRed
c01 = c01 & "," & cl.Address
End If
Next


If c01 <> "" Then
msg = "Cel " & c01 & " is niet ingevuld."
MsgBox msg
Range("E5").Value = msg
End If
End Sub
 
tabbladnaam tussen ""
als je mijn code bekijkt zie je dat de voorwaardes gescheiden worden door een komma.

Niels
 
Laatst bewerkt:
probleem opgelost,

als er een nieuw bestand wordt geoepend houd hij wel de rode cellen van de vorige keer deze moeten dus gereset worden

Code: 
Sheets("Leaflet").Select
    Range("B1:B400").Select
cl.Interior.Color = vbWhite
 
Vbwhite is niet resetten maar wit inkleuren, probeer dit nooit te doen want het voegt niks toe
behalve nuttloze bytes aan je bestand.

Select in je macro is ook bijna nooit nodig
Code: 
Sheets("Leaflet").Range("B1:B400").Interior.Color = xlNone

Niels
 
excel2010 zeker?



probeer het eens zo

Code: 
   With Sheets("Leaflet").Range("B1:B400").Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

of zo:

Code: 
Sheets("Leaflet").Range("B1:B400").Interior.Pattern = xlNone


Niels
 
Laatst bewerkt:
Hij zoekt nu alle foute cellen, omdat in de opmaak automatisch $B$4 enzv kwam te staan heb ik deze weggehaald. Maar nu geeft hij een foutmelding als er geen fouten zijn gevonden. Dan wil hij namelijk alle $ weghalen in een cel die al leeg is: dit wordt op gelost met if then else

Code: 
If [E5] = "" Then nothing
Else: For Each cl In Range("E5:E6").SpecialCells(2)
cl.Value = Replace(cl.Value, "$", "")
Next
 
De lege cellen worden weergeven in E5 als : Cel, $B$4, $B$20 enzv hier heb ik zelf B4, en B20 van gemaakt door van alle "$" --> "" te maken.

Ik denk dat het hier thuis hoort omdat de bestaande code hierdoor verbeterd wordt,

of heb ik ongelijk?
 
Ik weet totaal niet waar je het over hebt.

volgens mij bedoel je dit maar wees eens duidelijker,


Code: 
If c01 <> "" Then
c01 = Replace(c01, "$", "")
msg = "Cel " & c01 & " is niet ingevuld."
MsgBox msg
Range("E5").Value = msg
End If



Niels
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan