Verificare completare celule
-
- Mesaje: 52
- Membru din: Mar Mar 04, 2014 8:03 am
Verificare completare celule
Buna ziua,
Am un tabel in care vreau sa verific daca:
- pe randul 2 celulele B2,C2,D2 sau B2,C2,E2 sunt completate,
- celulele D2, E2 sa fie completate doar una din ele.
Eu am facut urmatorul macro:
Sub Verificare()
R021 = Application.CountA(Sheets("Test").Range("B2,C2,D2"))
R022 = Application.CountA(Sheets("Test").Range("B2,C2,E2"))
R023 = Application.CountA(Sheets("Test").Range("D2,E2"))
If (R021 = 0 Or R021 = 3) Or (R022 = 0 Or R022 = 3) Then Else MsgBox "Randul 1 incomplet!": Exit Sub
If R023 = 0 Or R023 = 1 Then Else MsgBox ("Nu puteti avea in acelasi timp Incasari si Plati!"): Exit Sub
R031 = Application.CountA(Sheets("Test").Range("B3,C3,D3"))
R032 = Application.CountA(Sheets("Test").Range("B3,C3,E3"))
R033 = Application.CountA(Sheets("Test").Range("D3,E3"))
If (R031 = 0 Or R031 = 3) Or (R032 = 0 Or R032 = 3) Then Else MsgBox "Randul 2 incomplet!": Exit Sub
If R033 = 0 Or R033 = 1 Then Else MsgBox ("Nu puteti avea in acelasi timp Incasari si Plati!"): Exit Sub
End Sub
Am scris doar doua randuri, in total sunt 24 iar macro-ul va fi urias.
Exista vreo modalitate prin care macro-ul sa fie mult mai mic, "mai elegant", mai usor de scris.
Cu stima, Marcel.
Am un tabel in care vreau sa verific daca:
- pe randul 2 celulele B2,C2,D2 sau B2,C2,E2 sunt completate,
- celulele D2, E2 sa fie completate doar una din ele.
Eu am facut urmatorul macro:
Sub Verificare()
R021 = Application.CountA(Sheets("Test").Range("B2,C2,D2"))
R022 = Application.CountA(Sheets("Test").Range("B2,C2,E2"))
R023 = Application.CountA(Sheets("Test").Range("D2,E2"))
If (R021 = 0 Or R021 = 3) Or (R022 = 0 Or R022 = 3) Then Else MsgBox "Randul 1 incomplet!": Exit Sub
If R023 = 0 Or R023 = 1 Then Else MsgBox ("Nu puteti avea in acelasi timp Incasari si Plati!"): Exit Sub
R031 = Application.CountA(Sheets("Test").Range("B3,C3,D3"))
R032 = Application.CountA(Sheets("Test").Range("B3,C3,E3"))
R033 = Application.CountA(Sheets("Test").Range("D3,E3"))
If (R031 = 0 Or R031 = 3) Or (R032 = 0 Or R032 = 3) Then Else MsgBox "Randul 2 incomplet!": Exit Sub
If R033 = 0 Or R033 = 1 Then Else MsgBox ("Nu puteti avea in acelasi timp Incasari si Plati!"): Exit Sub
End Sub
Am scris doar doua randuri, in total sunt 24 iar macro-ul va fi urias.
Exista vreo modalitate prin care macro-ul sa fie mult mai mic, "mai elegant", mai usor de scris.
Cu stima, Marcel.
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
Re: Verificare completare celule
Buna ziua
Testati codul din fisierul atasat
IP
Testati codul din fisierul atasat
Cod: Selectaţi tot
Sub Verificare()
'IPP - 11.08.2017
Application.ScreenUpdating = False
Dim myRng As Range
Set myRng = Sheets("Test").Range("A2:A25")
Dim result1 As Integer, result2 As Integer, result3 As Integer
For Each c In myRng
result1 = Application.CountA(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 3))
result2 = Application.CountA(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4))
result3 = Application.CountA(c.Offset(0, 3), c.Offset(0, 4))
'pt rand necompletat
If result1 + result2 + result3 = 0 Then
MsgBox "Randul de la nr. crt. " & c.Value & " este gol"
Exit Sub
End If
'pt rand completat partial
If result1 <> 3 And result2 <> 3 Then
MsgBox "Randul " & c.Value & " este incomplet"
Exit Sub
End If
'pt dubla completare
If result3 <> 1 Then
MsgBox "Nu puteti avea in acelasi timp Incasari si Plati!" & Chr(10) & _
"Verificati randul " & c.Value
Exit Sub
End If
result1 = 0
result2 = 0
result3 = 0
Next c
Application.ScreenUpdating = True
End Sub
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
-
- Mesaje: 52
- Membru din: Mar Mar 04, 2014 8:03 am
Re: Verificare completare celule
La " 'pt rand necompletat" renuntam. La nr.crt. vor fi numerotate numai randurile completate.
Mesajul de avertizare trebuie sa apara doar daca de ex. Randul 2 nu este complet.
Cand randul este complet sau este gol nu am nevoie de mesaj.
Mesajul de avertizare trebuie sa apara doar daca de ex. Randul 2 nu este complet.
Cand randul este complet sau este gol nu am nevoie de mesaj.
-
- Mesaje: 52
- Membru din: Mar Mar 04, 2014 8:03 am
Re: Verificare completare celule
Am facut urmatoarea modificare, cred ca e OK.
'pt rand necompletat
If result1 = 0 And result2 = 0 Then
Exit Sub
End If
'pt rand necompletat
If result1 = 0 And result2 = 0 Then
Exit Sub
End If
-
- Mesaje: 52
- Membru din: Mar Mar 04, 2014 8:03 am
Re: Verificare completare celule
Multumesc pentru ajutor.