Ir ao conteúdo
  • Cadastre-se

Matriz em VBA


Luizrcm

Posts recomendados

Olá pessoal tudo bem?

Estou com um pequeno problema de resposta do programa que fiz em vba, pois dentro desse código tenho duas matrizes com um total de quase 2 milhões de registros, ou seja, uma está declarada assim

varredura(30000,30)

e a outra assim

dataprox(30000,30)

totalizando 1,8M de registros.

Estou utilizando o FOR para selecionar cada registro da matriz para gravar

(parte do código)

for linha = 2 to 30000

for coluna = 1 to 30

varredura(linha,coluna)

.

.

.

.

next coluna

next linha

bem o problema é que demora de mais para terminar a execução dessa instrução pois faço a varredura e tratativa desses valores dentro desses FORs, queria saber se tem outro jeito de otimizar esse meu código.

(Todo o códogo)

Sub Auto_Open()

Dim varredura(40001, 41) As Long

Dim linha As Integer

Dim coluna As Integer

Dim prazo As Integer

Dim dataprox(30001, 31) As String

Dim dataconvert As Date

Dim menordata As Date

Dim mudalinha As Integer

coluna = 1

linha = 2

prazo = 0

menordata = Worksheets("Plan1").Cells(1, 25).Value

For linha = 2 To 30000

For coluna = 1 To 30

varredura(linha, coluna) = Worksheets("Plan1").Cells(linha, coluna).Value

Select Case varredura(linha, coluna)

Case 7

prazo = 10

dataconvert = Worksheets("Plan1").Cells(2, 23).Value + prazo

dataprox(linha, coluna) = CStr(dataconvert)

If dataprox(linha, coluna) < Worksheets("Plan1").Cells(1, 25).Value Then

Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbRed

Else

Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbWhite

End If

Case 13

prazo = 15

dataconvert = Worksheets("Plan1").Cells(2, 23).Value + prazo

dataprox(linha, coluna) = CStr(dataconvert)

If dataprox(linha, coluna) < Worksheets("Plan1").Cells(1, 25).Value Then

Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbRed

Else

Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbWhite

End If

Case 14

prazo = 30

dataconvert = Worksheets("Plan1").Cells(2, 23).Value + prazo

dataprox(linha, coluna) = CStr(dataconvert)

If dataprox(linha, coluna) < Worksheets("Plan1").Cells(1, 25).Value Then

Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbRed

Else

Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbWhite

End If

Case 25

prazo = 60

dataconvert = Worksheets("Plan1").Cells(2, 23).Value + prazo

dataprox(linha, coluna) = CStr(dataconvert)

If dataprox(linha, coluna) < Worksheets("Plan1").Cells(1, 25).Value Then

Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbRed

Else

Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbWhite

End If

Case 30

prazo = 90

dataconvert = Worksheets("Plan1").Cells(2, 23).Value + prazo

dataprox(linha, coluna) = CStr(dataconvert)

If dataprox(linha, coluna) < Worksheets("Plan1").Cells(1, 25).Value Then

Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbRed

Else

Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbWhite

End If

End Select

Worksheets("Plan1").Cells(linha, coluna + 23).Value = dataprox

Next coluna

Next linha

End Sub

obrigado

Link para o comentário
Compartilhar em outros sites

Experimente utilizar o código

Application.ScreenUpdating = False

no início da macro e

Application.ScreenUpdating = True

no final.

Isso vai agilizar bastante o processo.

Abraços.

Vai ficar assim:

Sub Auto_Open()

Dim varredura(40001, 41) As Long
Dim linha As Integer
Dim coluna As Integer
Dim prazo As Integer
Dim dataprox(30001, 31) As String
Dim dataconvert As Date
Dim menordata As Date
Dim mudalinha As Integer

Application.ScreenUpdating = False

coluna = 1
linha = 2
prazo = 0
menordata = Worksheets("Plan1").Cells(1, 25).Value

For linha = 2 To 30000

For coluna = 1 To 30

varredura(linha, coluna) = Worksheets("Plan1").Cells(linha, coluna).Value

Select Case varredura(linha, coluna)

Case 7
prazo = 10
dataconvert = Worksheets("Plan1").Cells(2, 23).Value + prazo
dataprox(linha, coluna) = CStr(dataconvert)
If dataprox(linha, coluna) < Worksheets("Plan1").Cells(1, 25).Value Then
Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbRed
Else
Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbWhite
End If

Case 13
prazo = 15
dataconvert = Worksheets("Plan1").Cells(2, 23).Value + prazo
dataprox(linha, coluna) = CStr(dataconvert)
If dataprox(linha, coluna) < Worksheets("Plan1").Cells(1, 25).Value Then
Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbRed
Else
Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbWhite
End If

Case 14
prazo = 30
dataconvert = Worksheets("Plan1").Cells(2, 23).Value + prazo
dataprox(linha, coluna) = CStr(dataconvert)
If dataprox(linha, coluna) < Worksheets("Plan1").Cells(1, 25).Value Then
Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbRed
Else
Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbWhite
End If

Case 25
prazo = 60
dataconvert = Worksheets("Plan1").Cells(2, 23).Value + prazo
dataprox(linha, coluna) = CStr(dataconvert)
If dataprox(linha, coluna) < Worksheets("Plan1").Cells(1, 25).Value Then
Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbRed
Else
Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbWhite
End If

Case 30
prazo = 90
dataconvert = Worksheets("Plan1").Cells(2, 23).Value + prazo
dataprox(linha, coluna) = CStr(dataconvert)
If dataprox(linha, coluna) < Worksheets("Plan1").Cells(1, 25).Value Then
Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbRed
Else
Worksheets("Plan1").Cells(linha, coluna).Interior.Color = vbWhite
End If

End Select
Worksheets("Plan1").Cells(linha, coluna + 23).Value = dataprox

Next coluna
Next linha

Application.ScreenUpdating = True

End Sub

Link para o comentário
Compartilhar em outros sites

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...