Verificare completare celule

Închis
Moga Marcel
Mesaje: 52
Membru din: Mar Mar 04, 2014 8:03 am

Verificare completare celule

Mesaj de Moga Marcel » Joi Aug 10, 2017 6:49 pm

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.
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.

IPP
Moderator
Moderator
Mesaje: 4196
Membru din: Mie Iul 29, 2009 7:26 am
Localitate: Cluj-Napoca

Re: Verificare completare celule

Mesaj de IPP » Vin Aug 11, 2017 8:05 am

Buna ziua

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
IP
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.

Moga Marcel
Mesaje: 52
Membru din: Mar Mar 04, 2014 8:03 am

Re: Verificare completare celule

Mesaj de Moga Marcel » Vin Aug 11, 2017 4:34 pm

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.

Moga Marcel
Mesaje: 52
Membru din: Mar Mar 04, 2014 8:03 am

Re: Verificare completare celule

Mesaj de Moga Marcel » Vin Aug 11, 2017 6:09 pm

Am facut urmatoarea modificare, cred ca e OK.
'pt rand necompletat
If result1 = 0 And result2 = 0 Then
Exit Sub
End If

Moga Marcel
Mesaje: 52
Membru din: Mar Mar 04, 2014 8:03 am

Re: Verificare completare celule

Mesaj de Moga Marcel » Dum Aug 13, 2017 2:53 pm

Multumesc pentru ajutor.

Închis

Înapoi la “Visual Basic for Application (VBA) cu Excel - Intrebari tehnice”