Jump to content

Várias Condições IF = VBA Lento...


Recommended Posts

Boa tarde,

Tenho um projecto no qual existe uma UF que serve para receber várias informações e por sua vez registar nas plan respectivas.

Nessa UF existem várias linhas (textbox) e a informação dessas caixas só é registada se a condição IF for verdadeira, ou seja passa para a proxima se for verdadeira, caso contrário fica por ali.

Acontece que devido ao numero elevado de condições seguidas, o processo é lento...

Há alguma forma de podermos vir a substituir essas condições ou usar alguma ferramenta para ter uma maior rapidez na resposta?

Cump.

NJ

Link to comment
Share on other sites

Aqui vai:

Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets.Application.Sheets("DG_CBL")
iRow = ws.Cells(Rows.Count, 2) _
  .End(xlUp).Offset(1, 0).Row
ws.Cells(iRow, 2).Value = TextBox51.Value
ws.Cells(iRow, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow, 4).Value = TextBox50.Value
ws.Cells(iRow, 5).Value = TextBox1.Value
ws.Cells(iRow, 6).Value = TextBox2.Value
ws.Cells(iRow, 7).Value = TextBox3.Value
ws.Cells(iRow, 8).Value = TextBox4.Value
ws.Cells(iRow, 9).Value = TextBox5.Value

If TextBox6.Value = "" Then
Else
iRow = ws.Cells(Rows.Count, 2) _
  .End(xlUp).Offset(1, 0).Row
ws.Cells(iRow, 2).Value = TextBox51.Value
ws.Cells(iRow, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow, 4).Value = TextBox50.Value
ws.Cells(iRow, 5).Value = TextBox6.Value
ws.Cells(iRow, 6).Value = TextBox7.Value
ws.Cells(iRow, 7).Value = TextBox8.Value
ws.Cells(iRow, 8).Value = TextBox9.Value
ws.Cells(iRow, 9).Value = TextBox10.Value
End If

If TextBox11.Value = "" Then
Else
iRow = ws.Cells(Rows.Count, 2) _
  .End(xlUp).Offset(1, 0).Row
ws.Cells(iRow, 2).Value = TextBox51.Value
ws.Cells(iRow, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow, 4).Value = TextBox50.Value
ws.Cells(iRow, 5).Value = TextBox11.Value
ws.Cells(iRow, 6).Value = TextBox12.Value
ws.Cells(iRow, 7).Value = TextBox13.Value
ws.Cells(iRow, 8).Value = TextBox14.Value
ws.Cells(iRow, 9).Value = TextBox15.Value
End If


If TextBox16.Value = "" Then
Else
iRow = ws.Cells(Rows.Count, 2) _
  .End(xlUp).Offset(1, 0).Row
ws.Cells(iRow, 2).Value = TextBox51.Value
ws.Cells(iRow, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow, 4).Value = TextBox50.Value
ws.Cells(iRow, 5).Value = TextBox16.Value
ws.Cells(iRow, 6).Value = TextBox17.Value
ws.Cells(iRow, 7).Value = TextBox18.Value
ws.Cells(iRow, 8).Value = TextBox19.Value
ws.Cells(iRow, 9).Value = TextBox20.Value
End If

If TextBox21.Value = "" Then
Else
iRow = ws.Cells(Rows.Count, 2) _
  .End(xlUp).Offset(1, 0).Row
ws.Cells(iRow, 2).Value = TextBox51.Value
ws.Cells(iRow, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow, 4).Value = TextBox50.Value
ws.Cells(iRow, 5).Value = TextBox21.Value
ws.Cells(iRow, 6).Value = TextBox22.Value
ws.Cells(iRow, 7).Value = TextBox23.Value
ws.Cells(iRow, 8).Value = TextBox24.Value
ws.Cells(iRow, 9).Value = TextBox25.Value
End If

If TextBox26.Value = "" Then
Else
iRow = ws.Cells(Rows.Count, 2) _
  .End(xlUp).Offset(1, 0).Row
ws.Cells(iRow, 2).Value = TextBox51.Value
ws.Cells(iRow, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow, 4).Value = TextBox50.Value
ws.Cells(iRow, 5).Value = TextBox26.Value
ws.Cells(iRow, 6).Value = TextBox27.Value
ws.Cells(iRow, 7).Value = TextBox28.Value
ws.Cells(iRow, 8).Value = TextBox29.Value
ws.Cells(iRow, 9).Value = TextBox30.Value
End If

If TextBox31.Value = "" Then
Else
iRow = ws.Cells(Rows.Count, 2) _
  .End(xlUp).Offset(1, 0).Row
ws.Cells(iRow, 2).Value = TextBox51.Value
ws.Cells(iRow, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow, 4).Value = TextBox50.Value
ws.Cells(iRow, 5).Value = TextBox31.Value
ws.Cells(iRow, 6).Value = TextBox32.Value
ws.Cells(iRow, 7).Value = TextBox33.Value
ws.Cells(iRow, 8).Value = TextBox34.Value
ws.Cells(iRow, 9).Value = TextBox35.Value
End If

If TextBox36.Value = "" Then
Else
iRow = ws.Cells(Rows.Count, 2) _
  .End(xlUp).Offset(1, 0).Row
ws.Cells(iRow, 2).Value = TextBox51.Value
ws.Cells(iRow, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow, 4).Value = TextBox50.Value
ws.Cells(iRow, 5).Value = TextBox36.Value
ws.Cells(iRow, 6).Value = TextBox37.Value
ws.Cells(iRow, 7).Value = TextBox38.Value
ws.Cells(iRow, 8).Value = TextBox39.Value
ws.Cells(iRow, 9).Value = TextBox40.Value
End If

If TextBox41.Value = "" Then
Else
iRow = ws.Cells(Rows.Count, 2) _
  .End(xlUp).Offset(1, 0).Row
ws.Cells(iRow, 2).Value = TextBox51.Value
ws.Cells(iRow, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow, 4).Value = TextBox50.Value
ws.Cells(iRow, 5).Value = TextBox41.Value
ws.Cells(iRow, 6).Value = TextBox42.Value
ws.Cells(iRow, 7).Value = TextBox43.Value
ws.Cells(iRow, 8).Value = TextBox44.Value
ws.Cells(iRow, 9).Value = TextBox45.Value
End If

Dim iRowx As Long
Dim wsx As Worksheet
Set wsx = Worksheets.Application.Sheets("Pendentes")
iRowx = wsx.Cells(Rows.Count, 2) _
  .End(xlUp).Offset(1, 0).Row
wsx.Cells(iRowx, 1).Value = UserForm9.NDocumento.Value
wsx.Cells(iRowx, 2).Value = UserForm9.Data.Value
wsx.Cells(iRowx, 3).Value = UserForm9.TotalDocumento.Value
wsx.Cells(iRowx, 4).Value = UserForm9.Fornecedor.Value
wsx.Cells(iRowx, 5).Value = "em aberto"

Plan75.Range("H11:I3000").HorizontalAlignment = 4

Unload Me
Link to comment
Share on other sites

Mostra lá com colocaste o ScreenUpdating no teu código? Leste o resto do artigo?

É que os If's são rápidos e não é por aí que o código fica lento. O código é lento a actualizar no excel e, se leste o artigo, se o excel fizer cálculos cada vez que actualizes um valor. Isso está explicado no artigo 🙂

Link to comment
Share on other sites

Fiz assim:

Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets.Application.Sheets("DG_CBL")

iRow = ws.Cells(Rows.Count, 2) _
  .End(xlUp).Offset(1, 0).Row
Application.ScreenUpdating = False
ws.Cells(iRow, 2).Value = TextBox51.Value
ws.Cells(iRow, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow, 4).Value = TextBox50.Value
ws.Cells(iRow, 5).Value = TextBox1.Value
ws.Cells(iRow, 6).Value = TextBox2.Value
ws.Cells(iRow, 7).Value = TextBox3.Value
ws.Cells(iRow, 8).Value = TextBox4.Value
ws.Cells(iRow, 9).Value = TextBox5.Value
Application.ScreenUpdating = True

If TextBox6.Value = Empty Then
Exit Sub
Plan75.Range("H11:I3000").HorizontalAlignment = 4
Unload Me
Run ("Regista_no_Livro_Selado")
Else
Application.ScreenUpdating = False
ws.Cells(iRow + 1, 2).Value = TextBox51.Value
ws.Cells(iRow + 1, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow + 1, 4).Value = TextBox50.Value
ws.Cells(iRow + 1, 5).Value = TextBox6.Value
ws.Cells(iRow + 1, 6).Value = TextBox7.Value
ws.Cells(iRow + 1, 7).Value = TextBox8.Value
ws.Cells(iRow + 1, 8).Value = TextBox9.Value
ws.Cells(iRow + 1, 9).Value = TextBox10.Value
Application.ScreenUpdating = True
End If

If TextBox11.Value = Empty Then
Exit Sub
Plan75.Range("H11:I3000").HorizontalAlignment = 4
Unload Me
Run ("Regista_no_Livro_Selado")
Else
Application.ScreenUpdating = False
ws.Cells(iRow + 2, 2).Value = TextBox51.Value
ws.Cells(iRow + 2, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow + 2, 4).Value = TextBox50.Value
ws.Cells(iRow + 2, 5).Value = TextBox11.Value
ws.Cells(iRow + 2, 6).Value = TextBox12.Value
ws.Cells(iRow + 2, 7).Value = TextBox13.Value
ws.Cells(iRow + 2, 8).Value = TextBox14.Value
ws.Cells(iRow + 2, 9).Value = TextBox15.Value
Application.ScreenUpdating = True
End If

If TextBox16.Value = Empty Then
Exit Sub
Plan75.Range("H11:I3000").HorizontalAlignment = 4
Unload Me
Run ("Regista_no_Livro_Selado")
Else
Application.ScreenUpdating = False
ws.Cells(iRow + 3, 2).Value = TextBox51.Value
ws.Cells(iRow + 3, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow + 3, 4).Value = TextBox50.Value
ws.Cells(iRow + 3, 5).Value = TextBox16.Value
ws.Cells(iRow + 3, 6).Value = TextBox17.Value
ws.Cells(iRow + 3, 7).Value = TextBox18.Value
ws.Cells(iRow + 3, 8).Value = TextBox19.Value
ws.Cells(iRow + 3, 9).Value = TextBox20.Value
Application.ScreenUpdating = True
End If

If TextBox21.Value = Empty Then
Exit Sub
Plan75.Range("H11:I3000").HorizontalAlignment = 4
Unload Me
Run ("Regista_no_Livro_Selado")
Else
Application.ScreenUpdating = False
ws.Cells(iRow + 4, 2).Value = TextBox51.Value
ws.Cells(iRow + 4, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow + 4, 4).Value = TextBox50.Value
ws.Cells(iRow + 4, 5).Value = TextBox21.Value
ws.Cells(iRow + 4, 6).Value = TextBox22.Value
ws.Cells(iRow + 4, 7).Value = TextBox23.Value
ws.Cells(iRow + 4, 8).Value = TextBox24.Value
ws.Cells(iRow + 4, 9).Value = TextBox25.Value
Application.ScreenUpdating = True
End If

If TextBox26.Value = Empty Then
Exit Sub
Plan75.Range("H11:I3000").HorizontalAlignment = 4
Unload Me
Run ("Regista_no_Livro_Selado")
Else
Application.ScreenUpdating = False
ws.Cells(iRow + 5, 2).Value = TextBox51.Value
ws.Cells(iRow + 5, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow + 5, 4).Value = TextBox50.Value
ws.Cells(iRow + 5, 5).Value = TextBox26.Value
ws.Cells(iRow + 5, 6).Value = TextBox27.Value
ws.Cells(iRow + 5, 7).Value = TextBox28.Value
ws.Cells(iRow + 5, 8).Value = TextBox29.Value
ws.Cells(iRow + 5, 9).Value = TextBox30.Value
Application.ScreenUpdating = True
End If

If TextBox31.Value = Empty Then
Exit Sub
Plan75.Range("H11:I3000").HorizontalAlignment = 4
Unload Me
Run ("Regista_no_Livro_Selado")
Else
Application.ScreenUpdating = False
ws.Cells(iRow + 6, 2).Value = TextBox51.Value
ws.Cells(iRow + 6, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow + 6, 4).Value = TextBox50.Value
ws.Cells(iRow + 6, 5).Value = TextBox31.Value
ws.Cells(iRow + 6, 6).Value = TextBox32.Value
ws.Cells(iRow + 6, 7).Value = TextBox33.Value
ws.Cells(iRow + 6, 8).Value = TextBox34.Value
ws.Cells(iRow + 6, 9).Value = TextBox35.Value
Application.ScreenUpdating = True
End If

If TextBox36.Value = Empty Then
Exit Sub
Plan75.Range("H11:I3000").HorizontalAlignment = 4
Unload Me
Run ("Regista_no_Livro_Selado")
Else
Application.ScreenUpdating = False
ws.Cells(iRow + 7, 2).Value = TextBox51.Value
ws.Cells(iRow + 7, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow + 7, 4).Value = TextBox50.Value
ws.Cells(iRow + 7, 5).Value = TextBox36.Value
ws.Cells(iRow + 7, 6).Value = TextBox37.Value
ws.Cells(iRow + 7, 7).Value = TextBox38.Value
ws.Cells(iRow + 7, 8).Value = TextBox39.Value
ws.Cells(iRow + 7, 9).Value = TextBox40.Value
Application.ScreenUpdating = True
End If

If TextBox41.Value = Empty Then
Exit Sub
Plan75.Range("H11:I3000").HorizontalAlignment = 4
Unload Me
Run ("Regista_no_Livro_Selado")
Else
Application.ScreenUpdating = False
ws.Cells(iRow + 8, 2).Value = TextBox51.Value
ws.Cells(iRow + 8, 3).Value = DateValue(UserForm9.Data.Value)
ws.Cells(iRow + 8, 4).Value = TextBox50.Value
ws.Cells(iRow + 8, 5).Value = TextBox41.Value
ws.Cells(iRow + 8, 6).Value = TextBox42.Value
ws.Cells(iRow + 8, 7).Value = TextBox43.Value
ws.Cells(iRow + 8, 8).Value = TextBox44.Value
ws.Cells(iRow + 8, 9).Value = TextBox45.Value
Application.ScreenUpdating = True
End If


Dim iRowx As Long
Dim wsx As Worksheet
Set wsx = Worksheets.Application.Sheets("Pendentes")
iRowx = wsx.Cells(Rows.Count, 2) _
  .End(xlUp).Offset(1, 0).Row
wsx.Cells(iRowx, 1).Value = UserForm9.NDocumento.Value
wsx.Cells(iRowx, 2).Value = UserForm9.Data.Value
wsx.Cells(iRowx, 3).Value = UserForm9.TotalDocumento.Value
wsx.Cells(iRowx, 4).Value = UserForm9.Fornecedor.Value
wsx.Cells(iRowx, 5).Value = "em aberto"
Link to comment
Share on other sites

Sim, eu até tinha apenas no início e no fim, mas pensei se assim seria mais rápido sempre que houvesse alterações a efectuar na plan...

Penso que as restantes dicas não serviam para este caso, esta do ScreenUpdating até penso que não trará neste caso melhoria...

Link to comment
Share on other sites

Estive a ver todo o meu projecto e desde que implementei esta UF com este codigo é que ficou lento...

Testei noutra máquina mais potente e o tempo de desenvolvimento não é o mesmo, mais rápido...

Dou o tópico como encerrado, obrigado pelas dicas!  🙂

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.