|
Login
  • Page:
  • 1

TOPIC: Ciclo For Each Next per estrazione dati

Ciclo For Each Next per estrazione dati 5 years 8 months ago #9716

  • AiaceT
  • AiaceT's Avatar
  • OFFLINE
  • Expert Boarder
  • Posts: 135
  • Karma: 1
salve di nuovo a tutti

il file in allegato è una minima parte di un pdf convertito in excel da cui vorrei estrapolare solamente due dati:

i numeri di serie
le relative qtà in arrivo per ogni numero di serie

come vedrete la conversione ha realizzato una distribuzione dei dati a macchia di leopardo in cui comunque ogni numero di serie si trova quasi sempre nella cella a destra rispetto a quella dove sta scritto "Serie"

nel caso invece della quantità, queste sono sempre:
una riga sopra rispetto al numero di serie e 11 colonne a destra sulla stessa riga

vorrei creare un ciclo For Each Next in cui
Dim cella As Range
Dim intervallo As Range
e con
set intervallo = Range("A1:AA(ultima riga della mio file)"

all'interno dell'intervallo avvenga l'estrazione dei dati in base al codice di cui poco più in basso

dal momento che non ho ancora (ahime ben capito i cicli) prego chi mi rispoderà di volermi spiegare come impostarli in modo da poter imparare questo (per me) nuovo aspetto di VBA

Ecco il codice e grazie in anticipo dell'aiuto:
Sub fcp()
      '
      ' fcp Macro
      ' Macro registrata il 28/02/2015 da Gianluca
      '

      '
10        Cells.Find(What:="Serie", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
              :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
              False, SearchFormat:=False).Activate 'trova la cella con scritto Serie
20        ActiveCell.Offset(0, 1).Range("A1").Select 'si sposta di una cella a sinistra
30        Selection.Copy 'copia il valore contenuto nella cella
40        Sheets("estratto").Select 'attiva il foglio dove va incollato il n° di serie
50        ActiveCell.Offset(0, -1).Range("A1").Select 'attiva la cella A1
60        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False 'incolla valore in cella A1
70        ActiveCell.Offset(0, 1).Range("A1").Select 'si sposta di una cella a sinistra (dove andrà scritto il n° di pcs attesi)
80        Sheets("base").Select 'attiva il foglio dove va recuperato il n° di pcs attesi
90        Application.CutCopyMode = False 'disattiva la cornice lampeggiante relativa al precedente copia
100       ActiveCell.Offset(-1, 11).Range("A1").Select 'si sposta di una riga in alto e di 11 a sinistra dove normalmente c'è la qtà pcs attesi
110       Selection.Copy 'copia il valore della cella pcs attesi
120       Sheets("estratto").Select 'attiva il foglio dove va incollato il n° di pcs attesi
130       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False 'incolla valore in cella a sx di quella dove è scritto il n° di serie
140       ActiveCell.Offset(1, -1).Range("A1").Select 'si sposta di una cella a sx e di una in basso (=si sposta sulla nuova riga dove scriverà altri due dati)
150       Sheets("base").Select 'attiva il foglio dove va recuperato il successivo n° di serie
160       Application.CutCopyMode = False 'disattiva la cornice lampeggiante relativa al precedente copia
170       Cells.Find(What:="Serie", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
              :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
              False, SearchFormat:=False).Activate   'esegue il Trova della stringa di testo "Serie" all'interno del foglio

180       Cells.FindNext(After:=ActiveCell).Activate 'esegue un ulteriore Trova della cella "Serie" in modo da trovare per certo la stringa di testo "Serie" successiva
                                                     'viceversa troverebbe la stessa stringa "Serie" trovata in precedenza

190       ActiveCell.Offset(0, 1).Range("A1").Select 'si sposta di una cella a sinistra
200       Selection.Copy 'copia il valore contenuto nella cella
210       Sheets("estratto").Select 'attiva il foglio dove va incollato il successivo n° di serie
220       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False 'incolla valore nella cella rimasta attiva dopo l'istruzione alla riga 140
230       ActiveCell.Offset(0, 1).Range("A1").Select 'si sposta di una cella a sinistra (dove andrà scritto il n° di pcs attesi)
240       Sheets("base").Select 'attiva il foglio dove va recuperato il successivo n° di serie
250       Application.CutCopyMode = False 'disattiva la cornice lampeggiante relativa al precedente copia
260       ActiveCell.Offset(-1, 11).Range("A1").Select 'si sposta di una riga in alto e di 11 a sinistra dove normalmente c'è la qtà pcs attesi
270       Selection.Copy 'copia il valore della cella pcs attesi
280       Sheets("estratto").Select 'attiva il foglio dove va incollato il n° di pcs attesi
290       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False 'incolla valore in cella a sx di quella dove è scritto il n° di serie
300       ActiveCell.Offset(1, -1).Range("A1").Select 'si sposta di una cella a sx e di una in basso (=si sposta sulla nuova riga dove scriverà altri due dati)
310       Sheets("base").Select 'attiva il foglio dove va recuperato il successivo n° di serie
320       Application.CutCopyMode = False 'disattiva la cornice lampeggiante relativa al precedente copia
330       Cells.Find(What:="Serie", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
              :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
              False, SearchFormat:=False).Activate 'esegue il Trova della stringa di testo "Serie" all'interno del foglio
340       Cells.FindNext(After:=ActiveCell).Activate 'esegue un ulteriore Trova della cella "Serie" in modo da trovare per certo la stringa di testo "Serie" successiva
                                                     'viceversa troverebbe la stessa stringa "Serie" trovata in precedenza

End Sub
Attachments:
AiaceT
excel 2003 su Windows Xp Sp3
The administrator has disabled public write access.
  • Page:
  • 1
Time to create page: 0.340 seconds