Notifications
Clear all

Copiar, procurar e colar

32 Posts
2 Usuários
0 Reactions
3,920 Visualizações
(@miguexcel)
Posts: 167
Estimable Member
Topic starter
 

Boa noite,

No ficheiro anexado, pretendo fazer alterações na coluna B da planilha 2. Depois, gostava de clicar no botão e que essa alteração passasse para a planilha 1 e que substituisse a informação da coluna B na planilha 1 no número que pedi para alterar.

Alguém me consegue ajudar? Se não entenderem peçam para explicar melhor

 
Postado : 03/02/2013 4:30 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Segue uma parte!!

Faça os teste, essa rotina vai deletar caso encontre na Sheet1, e deletar.

Sub DeletarCorrespAleVBA()
Dim vW As Variant
Dim fR As Range
Dim lngCounter As Long

For lngCounter = 2 To 3
  vW = Sheets("Sheet2").Cells(lngCounter, "A").Value
  With Sheets("Sheet1")
      Set fR = .Range("A:F").Find(what:=vW, after:=.Range("A1"), LookIn:=xlFormulas, lookat:=xlWhole)
      If Not fR Is Nothing Then
          fR.Resize(1, 6).Delete shift:=xlUp
      Else
          MsgBox "Não encontrado " & vW
      End If
  End With
Next lngCounter
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 10/02/2013 8:27 am
(@miguexcel)
Posts: 167
Estimable Member
Topic starter
 

Está perfeito Alex. Fiz o teste em meu arquivo e funciona na perfeição. Agora está só faltando a parte de alterar caso encontre.

Muito obrigado

 
Postado : 10/02/2013 10:13 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Considere como a terceira parte.

Option Explicit

Sub Parte_III()
    
    Dim x, K1 As Range, K2, i As Long, r As Long
    
    Set K1 = Sheet1.Range("a1").CurrentRegion.Columns(1)
    K2 = Sheet2.Range("a1").CurrentRegion.Value2
    
    r = K1.Rows.Count
    For i = 2 To UBound(K2, 1)
        x = Application.Match(K2(i, 1), K1.Value2, 0)
        If IsError(x) Then
            K1.Cells(1).Offset(r).Resize(, UBound(K2, 2)) = Application.Index(K2, i, 0)
            r = r + 1
        End If
    Next
    
End Sub

Foi primeiramente para Substituir, depois para Deleltar e agora Inserir
Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 11/02/2013 10:13 am
(@miguexcel)
Posts: 167
Estimable Member
Topic starter
 

Valeu Alex. Está tudo perfeito! Mas não entendo bem os códigos. Já agora, quando você me enviou a parte de substituir, apenas consideravamos uma linha. Agora temos duas linhas para substituir. Está dificil de adaptar... =(

 
Postado : 14/02/2013 6:47 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

Já agora, quando você me enviou a parte de substituir, apenas consideravamos uma linha. Agora temos duas linhas para substituir. Está dificil de adaptar...

Mas não era isso, que você queria???

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 14/02/2013 6:55 pm
(@miguexcel)
Posts: 167
Estimable Member
Topic starter
 

Não. Inicialmente eu tinha uma linha. Mas depois, começámos a trabalhar com duas linhas. Então para inserir as duas linhas está tudo perfeito. Para Deletar duas linhas também. Mas se eu quiser alterar e substituir as duas linhas não tenho como.

 
Postado : 14/02/2013 7:02 pm
(@miguexcel)
Posts: 167
Estimable Member
Topic starter
 

Alex,

Novidades?

 
Postado : 16/02/2013 6:23 am
(@miguexcel)
Posts: 167
Estimable Member
Topic starter
 

Boa tarde!!

Considere como a terceira parte.

Option Explicit

Sub Parte_III()
    
    Dim x, K1 As Range, K2, i As Long, r As Long
    
    Set K1 = Sheet1.Range("a1").CurrentRegion.Columns(1)
    K2 = Sheet2.Range("a1").CurrentRegion.Value2
    
    r = K1.Rows.Count
    For i = 2 To UBound(K2, 1)
        x = Application.Match(K2(i, 1), K1.Value2, 0)
        If IsError(x) Then
            K1.Cells(1).Offset(r).Resize(, UBound(K2, 2)) = Application.Index(K2, i, 0)
            r = r + 1
        End If
    Next
    
End Sub

Foi primeiramente para Substituir, depois para Deleltar e agora Inserir
Att

Alexandre,

Está tudo funcionando lindamente. O único problema é na parte de substituir. Não consigo meter funcionando em duas linhas. Assim, só substitui a primeira linha. Eu normalmente faço as alterações na segunda linha e assim a macro não copia a segunda linha, apenas a primeira...
Será que consegue dar um jeito? Preciso que ela pegue nas duas linhas, procure na base de dados e substitua pelo que ha la com o mesmo numero.

 
Postado : 17/02/2013 9:44 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Segue uma possibilidade

Sub Parte_III()
       
Dim x As Long, i As Long
Sheets("Sheet1").Activate
i = Sheet1.Cells(Cells.Rows.Count, "A").End(xlUp).Row

x = Application.Match(Sheet2.Range("a2").Value, Sheet1.Range("A:A"), 0)
            If IsError(x) Then
                Sheet2.Range("A2:F3").Copy
                Range("A" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Application.CutCopyMode = False
            Else
                Sheet2.Range("A2:F3").Copy
                Range("A" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Application.CutCopyMode = False
            End If
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 17/02/2013 10:57 am
(@miguexcel)
Posts: 167
Estimable Member
Topic starter
 

Reinaldo,

muito obrigado pela contribuição, mas não está funcionando. Eu pretendo conforme o ficheiro que envio...Funciona quase na perfeição, mas não estou conseguindo adaptar para as duas linhas! Só dá para uma.

 
Postado : 17/02/2013 11:17 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Entendi que é para usar os valores de sheet2, e acrescentar ou modificar na sheet1, não é isso?

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 17/02/2013 2:35 pm
(@miguexcel)
Posts: 167
Estimable Member
Topic starter
 

Isso mesmo Reinaldo. Eu quero chamar para a sheet 2 um processo qualquer através do número que está na celula A2. Depois, faço as alterações que quiser, tanto na linha 1 como na linha 2. E depois quero inserir essas duas linhas (se aquele número ainda não existir) ou modificar (o que já existe)... Está entendendo? Mas como o Alexandre já me devolveu todos os passos, agora só preciso do passo "substituir", porque "acrescentar" o Alex já me deu o código que deverei utilizar! No ficheiro que enviei em anexo, o código para substituir apenas está a fazer isso numa linha.. e eu preciso nas duas!

 
Postado : 17/02/2013 3:06 pm
(@miguexcel)
Posts: 167
Estimable Member
Topic starter
 

Começo a desesperar para encontrar esta solução! =(

 
Postado : 18/02/2013 2:50 pm
(@miguexcel)
Posts: 167
Estimable Member
Topic starter
 

Pelo que vejo, não tem solução para isto não... :(

 
Postado : 19/02/2013 3:50 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

Veja se é isso

Sub VaiDarcerto()

    Dim Cell As Range
    Dim DstRng As Range
    Dim Ids As Collection
    Dim n As Long, r As Long
    Dim RngEnd As Range
    Dim SrcRng As Range
    
        Set Ids = New Collection
        
        Set DstRng = Sheet1.Range("A2")
        Set SrcRng = Sheet2.Range("A2")
        
            Set RngEnd = DstRng.Parent.Cells(Rows.Count, DstRng.Column).End(xlUp)
            If RngEnd.Row < DstRng.Row Then Exit Sub
            
            Set DstRng = DstRng.Resize(RngEnd.Row - DstRng.Row + 1)
        
            Set SrcRng = SrcRng.CurrentRegion
            Set SrcRng = Intersect(SrcRng, SrcRng.Offset(1, 0))
        
            For Each Cell In SrcRng.Columns(1).Cells
                On Error Resume Next
                    Ids.Add Cell.Row - SrcRng.Row + 1, Cell.Text
                On Error GoTo 0
            Next Cell
    
            n = SrcRng.Columns.Count
        
            For Each Cell In DstRng.Columns(1).Cells
                On Error Resume Next
                    r = Ids(Cell.Text)
                    If Err = 0 Then Cell.Resize(1, n).Value = SrcRng.Rows(r).Value
                On Error GoTo 0
            Next Cell
        
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 19/02/2013 4:08 pm
Página 2 / 3