Macro que faz a Combinação Simples de uma sequencia de dados

[marcosian]

Olá amigos do forum,

sempre acompanhei e tirei minhas dúvidas no fórum quanto a VBA no excel, e montei recentemente uma macro para fazer o cruzamento de dados.

a macro precisa fazer o seguinte, cruzar os dados combinando os valores, e colar em outra aba o resultado deste cruzamento. este cruzamento de dados precisa ser feito como uma combinação simples, ou seja, cruzando a linha 1 com a linha 2 é a mesma coisa que a 2 com a 1.

pra chegar nisso a macro faz um loop dentro de outro loop, conforme a macro. no caso a plan2 é onde ficam os dados que vão ser cruzados, na plan3 é onde os dados são processados para encontrar o resultado. e na plan1 é onde o cruzamento é escrito.

qual é o problema. o excel está travando quando executo um cruzamento de muitos valores. e ele também parece que não está calculando devidamente (ele nao encerra o loop, por algum motivo que desconheci)

alguém tem alguma dica de como posso fazer para o excel melhorar a performance desta macro? e como faço para o loop encerrar certinho? pensei em jogar o resultado do cruzamento em outra planilha, mas preferi pedir ajuda aos mestres ,

Sub macro()

Dim n, x, p, i As Integer

Dim pra mim, sec As Integer

Dim Sht1 As Worksheet

Set Sht1 = Sheets("plan2")

n = Sht1.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count

p = 3

Sheets("plan1").Select

Range("A1").Select

Sheets("plan2").Select

pra mim = n - 1

sec = 0

x = 0

i = 0

Application.ScreenUpdating = False

Application.Visible = False

For i = 2 To pra mim

Sheets("plan2").Select

ActiveSheet.Range(Cells(i, 1), Cells(i, 1550)).Copy 'copia a area linha i coluna 1 até

linha p coluna 1550

Sheets("plan3").Select

Range("A2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

Sheets("plan2").Select

sec = i + 1

For x = sec To n

Sheets("plan2").Select

ActiveSheet.Range(Cells(x, 1), Cells(x, 1550)).Copy 'copia a area linha x coluna 1

até linha p coluna 1550

Sheets("plan3").Select

Range("A3").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

Range("A4:BGP4").Copy

Sheets("plan1").Select

ActiveCell.Offset(1, 0).Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

Sheets("plan3").Select

Next x

Next i

Application.ScreenUpdating = True

Application.Visible = True

End Sub

obrigado.

[Márcio Rodrigues]

Olá marcosian

Não entendi o que você quer. Mande a planilha com os dados e um exemplo do resultado para que possamos ajudá-lo.

Márcio