Macro Copia Trova Sposta

Hai un problema con Excel?

Nuova discussione

Macro, Copia ,Trova ,Sposta
di mancini6864 data: 29/07/2014 08:34:14
Ciao a tutti cercando tramite google ho trovato questo sito e ho preso l'occasione al balzo per chiedere aiuto.

vi pongo il mio problema:

ho due file word nominati 1 e 2, nel file 1 mi trovo una lista cosi:

C20
C21
C22
C23
C24
C25
C26
C27
C30
C31
C32
C35
C36
C37

nel file 2 trovo una seconda lista contenenti informazioni della prima,però sono moltissime e sparse nel file es:

C1995 | |CND0208 | |22uF 20% 16V X7R 125C 1210 |22UF |0 |2.075 |4.125 |90 |btm |a | |othe |CAP1210_null |alte |
C1996 | |CND0208 | |22uF 20% 16V X7R 125C 1210 |22UF |0 |1.850 |5.325 |270 |btm |a | |othe |CAP1210_null |alte |
C1997 | |CND0208 | |22uF 20% 16V X7R 125C 1210 |22UF |0 |2.100 |5.325 |270 |btm |a | |othe |CAP1210_null |alte |
C1998 | |CND0208 | |22uF 20% 16V X7R 125C 1210 |22UF |0 |1.975 |5.325 |270 |btm |a | |othe |CAP1210_null |alte |
C1999 | |CND0208 | |22uF 20% 16V X7R 125C 1210 |22UF |0 |1.725 |5.325 |270 |btm |a | |othe |CAP1210_null |alte |
C2 | |CND005998 | |CERAMIC CAPACITOR 2.2nF 50V 10% X7R SMD0402 -55'C/+125'C |2N2F |0 |18.300 |1.625 |90 |btm |a | |othe |RES0402_null |alte |
C20 | |CND0208 | |22uF 20% 16V X7R 125C 1210 |22UF |0 |18.875 |2.075 |270 |btm |a | |othe |CAP1210_null |alte |
C200 | |CND0208 | |22uF 20% 16V X7R 125C 1210 |22UF |0 |13.450 |0.725 |0 |btm |a | |othe |CAP1210_null |alte |
C2000 | |CND00352 | |CARAMIC CAPACITOR 330pF 50V 5% SMD0603 COG 125' |330PF |0 |1.275 |5.150 |270 |btm |a | |othe |CAP0603_CAP0603 |alte |
C2001 | |CND00352 | |CARAMIC CAPACITOR 330pF 50V 5% SMD0603 COG 125' |330PF |0 |1.050 |4.225 |270 |btm |a | |othe |CAP0603_CAP0603 |alte |
C2002 | |CND00352 | |CARAMIC CAPACITOR 330pF 50V 5% SMD0603 COG 125' |330PF |0 |1.700 |4.350 |270 |btm |a | |othe |CAP0603_CAP0603 |alte |
C2003 | |CND012325 | |CERAMIC CAPACITOR 4,7uF 16V X7R SMD1206 -55'C/+125'C |4U7F |0 |1.300 |4.150 |90 |btm |a | |othe |CAP1206_Wave_Solder. |alte |
C21 | |CND00352 | |CARAMIC CAPACITOR 330pF 50V 5% SMD0603 COG 125' |330PF |0 |17.825 |0.975 |270 |btm |a | |othe |CAP0603_CAP0603 |alte |

per dare ulteriori info si tratta di file contenente all'incirca 12000 righe.

io vorrei se possibile effettuare una macro che mi vada a leggere il valore nel file 1 e cercare nel file 2 per poi riportare informazioni e completare il file 1 es:

file 1
C20 | |CND0208 | |22uF 20% 16V X7R 125C 1210 |22UF |0 |18.875 |2.075 |270 |btm |a | |othe |CAP1210_null |alte |
C21 .......
C22 ........
C23.......
C24.......
C25.......
C26.......
C27.......
C30.......
C31.......
C32.......
C35.......
C36.......
C37.......

ho provato a registrare una macro , ma diciamo che fa il suo lavoro solo per la prima riga, credo che il problema sia su questo parametro che rimane fisso e non varia come vorrei IO:
With Selection.Find
.Text = "C20"

grazie in anticipo per chiunque mi aiuti

Sub CopiaTrovaSposta()
'
' CopiaTrovaSposta Macro
' Macro registrata il 29/07/14 da collaudi
'
    For I = 1 To 85  
    Selection.HomeKey Unit:=wdLine
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.Copy
    Windows("2").Activate
    Application.WindowState = wdWindowStateMaximize
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "C20"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.Copy
    Windows("1").Activate
    Selection.EndKey Unit:=wdLine
    Selection.PasteAndFormat (wdPasteDefault)

    Next I
End Sub

di lepat (utente non iscritto) data: 29/07/2014 08:44:38
allega un file di esempio

di mancini6864 (utente non iscritto) data: 29/07/2014 09:41:34
ho ricompilato il codice vba perche è questo quello che vorrei usare.

Sub CopiaTrovaSposta()
'
' CopiaTrovaSposta Macro
' Macro registrata il 29/07/14 da collaudi
'
    For i = 1 To 85
    Selection.HomeKey Unit:=wdLine
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.Copy
    Windows("2").Activate
    Application.Move Left:=273, Top:=3
    Windows("1").Activate
    Windows("2").Activate
    Application.Resize Width:=747, Height:=555
    Application.Move Left:=65, Top:=3
    Application.Resize Width:=955, Height:=555
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "C20 "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.Copy
    Windows("1").Activate
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "C20 "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.EndKey Unit:=wdLine
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.TypeBackspace
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.HomeKey Unit:=wdLine

    Next i
    
End Sub

di mancini6864 (utente non iscritto) data: 29/07/2014 09:48:22
il secondo allegato è un esempio di tipologia dei file che devo usare ,

vorrei capire se esiste una variabile da dare
With Selection.Find
.Text = "C20 "
in modo tale da andare a estrapolare tutti i codici del primo file 1 ed andarli a cercare sul secondo file 2 per poi copiarli ne file 1
di lepat (utente non iscritto) data: 29/07/2014 11:25:38
non hai preso in considerazione la possibilità di farlo con excel ? credo che sarebbe molto più semplice
di mancini6864 (utente non iscritto) data: 29/07/2014 12:38:24
a dire la verita ci ho pensato ma non saprei da dove incominciare.

qualche suggerimento??

io credo che il problema maggiore è su come interagire con il comando copia e trova
di lepat (utente non iscritto) data: 29/07/2014 12:46:00
il file con i dati è in txt ?
allega un file excel con i dati del doc in colonna A e col risultato desiderato per le prime 3 righe
di alfrimpa (utente non iscritto) data: 29/07/2014 12:53:19
Ciao Mancini

Come diceva giustamente Lepat (un saluto) con Excel la cosa sarebbe molto più semplice.

Ti allego file (molto grezzo) dove in cinque minuti credo di aver fatto quello che chiedi.

Guardalo e, se va bene, ti darò tutte le delucidazioni del caso.

N.B. Tutti gli N/D che vedi sul foglio1 derivano dal fatto che tutti i codici (tranne i primi due) della colonna A non sono presenti nella tabella del foglio2.

A disposizione

Alfredo
di alfrimpa (utente non iscritto) data: 29/07/2014 12:58:40
Perdonate ma solo ora ho visto la nuova risposta di Lepat.

Sicuramente, lui bravissimo con il VBA, scriverà una macro che farà il tutto in automatico.

Segnalo solo che copiando il file txt su un foglio Excel i dati vengono già suddivisi in colonne solo che nella prima vien aggiunto un carattere invisibile (o uno spazio) per cui bisogna depurare la colonna A da tale carattere.

Alfredo
di mancini6864 (utente non iscritto) data: 29/07/2014 13:29:54
grazie per la vostra collaborazione

si i file sono in txt

scusa ma non riesco a capire che significa "col risultato desiderato per le prime 3 righe"

ho creato un file exel che ho messo in allegato,

nel foglio 1 ho inserito la lista (di parole da cercare)

nel foglio 2 ho inserito la lista dove devo prendere informazioni

nel foglio 3 ho inserito il risultato che vorrei ottenere
di alfrimpa (utente non iscritto) data: 29/07/2014 13:34:36
Ciao

Non trovo il "tuo" file di Excel.

Hai dato un'occhiata a quello che ho allegato io (si chiama mancini.xls) ed è il primo a sinistra.

Mi sembra che, salvo aggiustamenti, faccia quello che chiedi.

Alfredo
di alfrimpa (utente non iscritto) data: 29/07/2014 14:01:20
Ho visto il tuo file e lo sto rielaborando.

Entro un'oretta conto di riallegarlo.

Alfredo
di alfrimpa (utente non iscritto) data: 29/07/2014 14:50:14
Ciao Mancini

Prova a vedere l'ultimo file allegato (mancini1.xls) e fai sapere

Alfredo
di MANCINI6864 (utente non iscritto) data: 29/07/2014 14:55:02
ora lo prendo e provo
di mancini6864 (utente non iscritto) data: 29/07/2014 15:01:38
è quello che cercavo anche se ho fornito tutti i dati come mai ancora ci sono delle nd.

che tipo di macro hai usato
di alfrimpa (utente non iscritto) data: 29/07/2014 15:11:42
Ciao

Non ho usato nessuna macro ma una semplice funzione di ricerca: il CERCA.VERT()

In generale, ti dico che gli ND vengono fuori se il valore cercato (in questo caso a1, a2 ecc del foglio19 non vengono trovati nella tabella di ricerca.

Ora faccio qualche verifica e ti dico

Alfredo
di alfrimpa (utente non iscritto) data: 29/07/2014 15:24:07
Ciao

Allora, il problema sono i "tuoi" dati.

Sul tuo foglio1 in colonna A dove esce fuori dalle formule ND vuol dire che in colonna A oltre al codice (C73 ad esempio) c'è anche uno spazio vuoto.

Inserisci una nuova colonna nel foglio1
in B1 scrivi =ANNULLA.SPAZI(A1) e ricopia in basso
Poi copia l'intera colonna B in A1 facendo Incolla Speciale -> Valori e vedrai che tutto dovrebbe sistemarsi

Tieni presente che per far funzionare il tutto anche i dati provenienti dal file txt (che tu hai messo nel foglio2 vanno un po' rielaborati)

Alfredo

di lepat (utente non iscritto) data: 29/07/2014 15:24:24
questa macro che apre il file di testo (situato nella stessa cartella del file xlsm) e mette il risultato nel foglio2

Sub Macro1()
Set wb = ThisWorkbook
LR = Cells(Rows.Count, "A").End(xlUp).Row
fname = "C:UsersuserDesktop2.txt" ' <<<<<<<<<<<<  da modificare
Workbooks.OpenText Filename:=fname, Origin:= _
        xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
        , ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= _
        False, Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array( _
        Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), _
        Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, _
        1), Array(15, 1), Array(16, 1), Array(17, 1)), TrailingMinusNumbers:=True
ActiveSheet.UsedRange.Copy wb.Sheets(2).Cells(1, 1)
ActiveWorkbook.Close False
Sheets(2).Range("B1, D1, M1").EntireColumn.Delete
With Sheets(2)
  LR2 = .Cells(.Rows.Count, "A").End(xlUp).Row

  For r = LR2 To 1 Step -1
    s = RTrim(.Cells(r, 1).Value)
    If Application.WorksheetFunction.CountIf(Sheets(1).Range("A1:A" & LR), RTrim(.Cells(r, 1).Value)) = 0 Then
      .Rows(r).Delete
    End If
  Next
End With
End Sub

di alfrimpa (utente non iscritto) data: 29/07/2014 15:31:44
L'avevo detto che Lepat con una macro avrebbe risolto tutto!

Mi ritiro in buon ordine

Comunque con piccole elaborazioni anche con un semplice cerca.vert credo si possa giungere più o meno allo stesso risultato.
Alfredo

p.s. @ Mancini

Ho ripulito gli spazi sulla colonna A del foglio1 e sono rimasti solo due codici (C2C3 e C7C8) che non ci sono sul foglio2 (forse è un errore).
di mancini6864 (utente non iscritto) data: 29/07/2014 15:43:06
si questi sono file di prova perchè i file con cui devo andare a lavorare sono molto piu grandi

di mancini6864 (utente non iscritto) data: 29/07/2014 16:14:42
o controllato il codice ma non riesco a capire

che cosa devo modificare per far ripetere tutta la procedura per tutti i valori del foglio 1.

se possibile nel foglio2 vorrei vedere il testo non diviso per tabelle ma come nel file txt,cosi da poterlo copiare ed incollare in un file txt.
non è per un mio capriccio ma è perchè dopo averlo ordinato devo trasferire il file di testo in una macchina che elabora i dati.

grazie a tutti per la collaborazione per ora quasi abbiamo raggiunto l'obbiettivo.

Sub Macro1()
Set wb = ThisWorkbook
LR = Cells(Rows.Count, "A").End(xlUp).Row
fname = "C:UsersuserDesktop2.txt" ' <<<<<<<<<<<<  da modificare
Workbooks.OpenText Filename:=fname, Origin:= _
        xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
        , ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= _
        False, Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array( _
        Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), _
        Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, _
        1), Array(15, 1), Array(16, 1), Array(17, 1)), TrailingMinusNumbers:=True
ActiveSheet.UsedRange.Copy wb.Sheets(2).Cells(1, 1)
ActiveWorkbook.Close False
Sheets(2).Range("B1, D1, M1").EntireColumn.Delete
With Sheets(2)
  LR2 = .Cells(.Rows.Count, "A").End(xlUp).Row

  For r = LR2 To 1 Step -1
    s = RTrim(.Cells(r, 1).Value)
    If Application.WorksheetFunction.CountIf(Sheets(1).Range("A1:A" & LR), RTrim(.Cells(r, 1).Value)) = 0 Then
      .Rows(r).Delete
    End If
  Next
End With
End Sub

di lepat (utente non iscritto) data: 29/07/2014 16:30:51
non devi fare niente, la macro lavora al contrario, copia il file nel foglio 2 ed elimina le righe che non vanno d'accordo col foglio1.
perché lo chiedi ? non raggiunge il risultato voluto ?
di alfrimpa (utente non iscritto) data: 29/07/2014 16:31:19
Ciao Mancini

La macro di Lepat fa già tutto quello che chiedi (l'unica cosa che devi modificare è il percorso del tuo file txt in quarta riga) e pone il risultato sul foglio2.

La mia proposta invece prevede la suddivisione del testo in colonne del foglio2, la ripulitura degli eventuali spazi presenti, eliminazione colonne vuote ecc. (tutto questo lo fa anche la macro)

Poi sul foglio1, con il cerca.vert vado a ripescarmi i dati relativi ad ogni codice (attenzione anche qui agli spazi vuoti).

Spero di aver capito ed essermi spiegato bene.

Alfredo
di alfrimpa (utente non iscritto) data: 29/07/2014 16:34:31
Ovviamente prego Lepat di intervenire qualora avessi travisato qualcosa del suo codice.

Alfredo

di lepat (utente non iscritto) data: 29/07/2014 16:38:10
prova questa

Sub a()
Set wb = ThisWorkbook
LR = Cells(Rows.Count, "A").End(xlUp).Row
fname = "C:UsersandreDesktop2.txt"
Workbooks.OpenText Filename:=fname
ActiveSheet.UsedRange.Copy wb.Sheets(2).Cells(1, 1)
ActiveWorkbook.Close False
With Sheets(2)
  LR2 = .Cells(.Rows.Count, "A").End(xlUp).Row
  For r = LR2 To 1 Step -1
    p = InStr(.Cells(r, 1).Value, "|") - 2
    s = Left(.Cells(r, 1).Value, p)
    If Application.WorksheetFunction.CountIf(Sheets(1).Range("A1:A" & LR), s) = 0 Then
      .Rows(r).Delete
    End If
  Next
End With
End Sub

di mancini6864 (utente non iscritto) data: 29/07/2014 18:08:09
grazie dopo un po di tentativi sono riuscito a farlo funzionare a dovere , ho avuto delle difficoltà per colpa di spazzi presenti nella lista 1

devo dire che il secondo VBA è quello che fa al caso mio direi Perfetto!!!

GRAZIE A TUTTI ..

Sub Macro1()
Set wb = ThisWorkbook
LR = Cells(Rows.Count, "A").End(xlUp).Row
fname = "C:Documents and SettingssimoneDesktop2.txt"
Workbooks.OpenText Filename:=fname
ActiveSheet.UsedRange.Copy wb.Sheets(2).Cells(1, 1)
ActiveWorkbook.Close False
With Sheets(2)
  LR2 = .Cells(.Rows.Count, "A").End(xlUp).Row
  For r = LR2 To 1 Step -1
    p = InStr(.Cells(r, 1).Value, "|") - 2
    s = Left(.Cells(r, 1).Value, p)
    If Application.WorksheetFunction.CountIf(Sheets(1).Range("A1:A" & LR), s) = 0 Then
      .Rows(r).Delete
    End If
  Next
End With
End Sub

Vuoi Approfondire?