Jump to content
njesus

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

Recommended Posts

njesus

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

Share this post


Link to post
Share on other sites
njesus

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

Share this post


Link to post
Share on other sites
Caça

Não deverias criar os IFs desta maneira

If TextBox6.Value = "" Then
Else

mas desta

If Not TextBox6.Value = Empty Then

ou desta

If TextBox6.Value <> Empty Then


Pedro Martins

Não respondo a duvidas por PM

Share this post


Link to post
Share on other sites
Caça

E esta linha de código só é precisa uma vez, a partir dai basta somar 8 ao "iRow"

iRow = ws.Cells(Rows.Count, 2) _
  .End(xlUp).Offset(1, 0).Row


Pedro Martins

Não respondo a duvidas por PM

Share this post


Link to post
Share on other sites
njesus

Rectifiquei os meus IF, coloquei o ScreenUpdating, mas o problema continua...  🤔

Será porque estou a escrever numa plan que não a activa!?

Share this post


Link to post
Share on other sites
jpaulino

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 :)

Share this post


Link to post
Share on other sites
njesus

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"

Share this post


Link to post
Share on other sites
jpaulino

Só precisas colocar no inicio e no fim ... não precisas de espalhar pelo código. Leste o artigo? Viste se as dicas se aplicam ao teu caso?

Share this post


Link to post
Share on other sites
njesus

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...

Share this post


Link to post
Share on other sites
jpaulino

Tens muitos calculos/fórumulas na folha? Tens outro código que é executado com no evento Change ou SelectionChange?

Verifica também se tens muitas imagens ou imagens pesadas.

Share this post


Link to post
Share on other sites
njesus

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!  :)

Share this post


Link to post
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

×
×
  • 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.