Codice vba per riportare diverse voci

Question

Buongiorno a tutti!

Ho la seguente domanda da porvi:

ho la necessità di trovare un codice che riconosca dove vi è una voce e me la riporti a fianco di una lista; proverò a spiegarmi meglio

con questo esempio dove vi riporto solo 3 schede(tutte le schede del mio file sono consecutive come segue)

Es°:

... e così via; ho da fare una

raccolta di pezzi di ricambio per un listino e nel foglio excel vi sono le varie schede dei pezzi con i relativi componenti, come vedete

ciascuna scheda può avere differente numero di componenti;

Il mio obiettivo sarebbe quello di riportare per ciascuna scheda la voce del titolo pezzo (quindi "FORK", "OPTIONAL PARTS FOR FORK ASSY",

MAST OPTIONAL PARTS" ecc) in una colonna ("SEC") a fianco dei vari componenti di ciascuna scheda (per esattezza nella colonna "n")

Ovviamente fossero poche schede componenti lo rifarei io a mano, ma il problema è che ve ne sono decine per ciascun modello di mezzo.

Questo sarebbe il mio obiettivo finale per ciascuna scheda.

Es°:

RINGRAZIO IN ANTICIPO CHI SARA' COSI' GENTILE DA AIUTARMI

Gianmaria

Answer 1

Ciao Gianmaria,

Innanzitutto grazie mille per l'interesse e la risposta esaustiva, sei stato davvero gentile vista la difficoltà e lunghezza a parer mio del problema.

Prego! :-)

La macro funziona e mi riporta i vari nomi a fianco di ciascuna lista; vi è solo un ultimo problema ma nulla di che dal momento che può comunque essere messo a posto manualmente una volta eseguita la macro:

In pratica la macro fa quel che deve fare ma, a differenza del file prova che mi hai condiviso, mi "trasla" di 2 righe tutte le celle riportate. 

[...]

Sostituisci

        destRng.Resize(UB).Value = arrOut

        Call MsgBox( _

             Prompt:="Finito!", _

             Buttons:=vbInformation, _

             Title:="REPORT")

XIT:

End Sub

con:

        destRng.Resize(UB).Offset(-2).Value = arrOut

        Call MsgBox( _

             Prompt:="Finito!", _

             Buttons:=vbInformation, _

             Title:="REPORT")

XIT:

End Sub

===

Regards,

Norman

Answer 2

Ciao Gianmaria,

Problema risolto!

Bene! Mi fa piacere.

Grazie mille per l'esaustività e la tempestività delle risposte Norman!

Grazie a te, Gianmaria, per il cortese riscontro.

Alla prossima.

===

Regards,

Norman

Answer 3

Problema risolto!

Grazie mille per l'esaustività e la tempestività delle risposte Norman!

Gianmaria

Answer 4

Ciao Norman!

Innanzitutto grazie mille per l'interesse e la risposta esaustiva, sei stato davvero gentile vista la difficoltà e lunghezza a parer mio del problema.

La macro funziona e mi riporta i vari nomi a fianco di ciascuna lista; vi è solo un ultimo problema ma nulla di che dal momento che può comunque essere messo a posto manualmente una volta eseguita la macro:

In pratica la macro fa quel che deve fare ma, a differenza del file prova che mi hai condiviso, mi "trasla" di 2 righe tutte le celle riportate. Ti allego uno screenshot per capire meglio quel che intendo:

Come detto sopra  comunque, non è un problema enorme visto che io posso manualmente allineare le colonne "a" e "b" con la "d" e viceversa una volta eseguita la macro, quindi se è un problema risolvibile con poco ben venga, altrimenti mi accontento del codice così com'è che sei già stato troppo gentile!

P.S. Se non dovesse rendere il post troppo corposo, ti allegherei anche lo screenshot del codice che ho inserito (a parte la voce "foglio.." non dovrei aver modificato nulla).

Anche se non dovessi trovare una soluzione comunque grazie ancora!!

Gianmaria

Answer 5

Ciao Gianmaria,

Ho la seguente domanda da porvi:

ho la necessità di trovare un codice che riconosca dove vi è una voce e me la riporti a fianco di una lista; proverò a spiegarmi meglio

con questo esempio dove vi riporto solo 3 schede(tutte le schede del mio file sono consecutive come segue)

Es°:

... e così via; ho da fare una

raccolta di pezzi di ricambio per un listino e nel foglio excel vi sono le varie schede dei pezzi con i relativi componenti, come vedete

ciascuna scheda può avere differente numero di componenti;

Il mio obiettivo sarebbe quello di riportare per ciascuna scheda la voce del titolo pezzo (quindi "FORK", "OPTIONAL PARTS FOR FORK ASSY",

MAST OPTIONAL PARTS" ecc) in una colonna ("SEC") a fianco dei vari componenti di ciascuna scheda (per esattezza nella colonna "n")

Ovviamente fossero poche schede componenti lo rifarei io a mano, ma il problema è che ve ne sono decine per ciascun modello di mezzo.

Questo sarebbe il mio obiettivo finale per ciascuna scheda.

Es°:

RINGRAZIO IN ANTICIPO CHI SARA' COSI' GENTILE DA AIUTARMI

Gianmaria

Prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range, destRng As Range

    Dim arrIn As Variant, arrOut As Variant

    Dim sStr As String, aStr As String

    Dim LRow As Long, UB As Long

    Dim i As Long

    Const sFoglio As String = "Foglio1"          '<<=== Modifica

    Const sPrimaCellaDestinazione = "D3"      '<<=== Modifica

    On Error GoTo XIT

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    With SH

        LRow = LastRow(SH, .Columns("A:A"))

        Set Rng = .Range("A1:B" & LRow)

        Set destRng = .Range(sPrimaCellaDestinazione)

    End With

    arrIn = Rng.Value

    UB = UBound(arrIn)

    ReDim arrOut(1 To UB, 1 To 1)

    For i = 1 To UB

        sStr = arrIn(i, 1)

        Select Case True

        Case sStr Like "SEC*"

            If i < UB Then

                aStr = arrIn(i + 1, 1)

            End If

            i = i + 2

            arrOut(i, 1) = "SEC"

           arrOut(i + 1, 1) = aStr

'            i = i + 2

        Case sStr Like "PART*"

'            '\ fa niente

        Case Else

            arrOut(i, 1) = aStr

        End Select

    Next i

    destRng.Resize(UB).Value = arrOut

        Call MsgBox( _

             Prompt:="Finito!", _

             Buttons:=vbInformation, _

             Title:="REPORT")

XIT:

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1, _

                        Optional sPassword As String)

    Dim bProtected As Boolean

    With SH

        If Rng Is Nothing Then

            Set Rng = .Cells

        End If

        bProtected = .ProtectContents = True

        If bProtected Then

            .Unprotect Password:=sPassword

        End If

    End With

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

    If bProtected Then

        SH.Protect Password:=sPassword, _

                   UserInterfaceOnly:=True

    End If

End Function

'<<=========

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm
• Alt+F8 per aprire  la finestra di gestione delle macro
• Seleziona Tester
• Esegui

Potresti scaricare il mio file di prova Gianmaria20180718.xlsm

Postscriptum

Ho modificato il codice e ho aggionato il mio file di prova per sradicare un piccolo errore!

===

Regards,

Norman