ESTRARRE NOMI DABASE

[3olo]

Ciao Flash,
ci sto un po' sbattendo la testa e non capisco alcune cose.
La prima cosa è che se in "B29" se scrivo "SR" e lancio la macro in riga "B44" non compare niente,funziona solo con WA,non capisco perchè.
volevo chiederti:
al passo StCo1 = Left(StrRic, 13) , come fa a estrapolare 13 caratteri di StrRic se questa variabile non è dichiarata...cioè:è una dicitura per una qualche funzione?Non riesco a capire
Altre cose che non capisco molto bene sono:
-i vari "Case", nel senso:ogni ciclo CC (for 1 to 6) seleziona il case corrispondente e gli altri li bypassa?
-in ogni Case dichiari StCo, ma poi sotto StCo1 ,StCo2,ecc corrispondono una al case 1 ,una al case 2,ecc? Quindi in CC=1 esamina solo Case 1 e StCo1 e il resto lo tralascia? Ho capito bene?
-StCo6 equivale al CASE Else?
-un'altra cosa che non capisco è perchè ad esempio sono diverse in case 2 StCo e StCo2
Case 2
StCo = FS.Range("D5").Text & "_" & FS.Range("D17").Text & FS.Range("D19").Text & FS.Range("D21").Text & FS.Range("D23").Text
-----
StCo2 = FS.Range("D17").Text & FS.Range("D19").Text & FS.Range("D21").Text & FS.Range("D23").Text


-If StrDb Like "*" & StCo & "*" Then : cosa vuol dire questa dicitura?

Un'altra cosa: se io mi ricreassi i vari Case partendo dal codice parlante in "A34" ci sarebbe qualche controindicazione secondo te? Ho visto che la vecchia macro l'avevi impostata così e mi piaceva di più.

Ecco,ti ringrazio tanto,sono un po' zuccone,mi dispiace

[Flash30005]

Tutte le righe comprese come indicato '---da, '--- a
possono essere eliminate (sono refusi utilizzati inizialmente lo studio)

Codice: Seleziona tutto

   For RR = 1 To UR '<<<< esistente lasciare
'---- da qui
        Tr = 0
        StCo1 = Left(StrRic, 13)
        StCo2 = FS.Range("D17").Text & FS.Range("D19").Text & FS.Range("D21").Text & FS.Range("D23").Text
        StCo3 = Left(FS.Range("D5").Text, 6) & "--" & Right(FS.Range("D5").Text, 2) & "----" & FS.Range("D13").Text & FS.Range("D15").Text
        StCo4 = FS.Range("D5").Text
        StCo5 = Left(FS.Range("D5").Text, 6) & "--" & Right(FS.Range("D5").Text, 2) & "_" & FS.Range("D11").Text
        StCo6 = Left(FS.Range("D5").Text, 3) & "-----" & FS.Range("D3").Text
'---- a qui eliminare le righe

        STrODB = Sheets("codici DB").Cells(RR, CC)'<<<< esistente lasciare


Il problema si SR controlla se esiste il corrispondente codice perché a io avviso dovrebbe funzionare
cioè se è SR cerca nella colonna F se WA nlla colonna G, se "00" salta, come da tua richiesta

La select serve per evitare una serie di condizioni ( If... If ... If etc)
e si riferisce alla colonna che andrà a processare

Il for CC 1 to 6 è il ciclo per processare le 6 colonne (o 7)
Quindi al variare di CC (da 1 a 6) verrà cercata la stringa chiave corrispondente che si differenzia da colonna a colonna

A dir la verità a mio avviso non occorrerebbe nemmeno avere il foglio "Codici DB" perché la chiave è di "facile" composizione
quindi perché cercarla in un database quando la si può "comporre"?'

ciao

[3olo]

Ciao flash! Grazie,devo un attimo elucubrare su quello che mi hai scritto,dammi tempo su quello. Per quanto riguarda invece il codice da comporre e l'esclusione del foglio codiciDB non posso,perché quei codici li sono univoci e se vedi prima di ed0 in ogni codice c'è un numero di 4cifre, come farei a comporre quel numero senza spulciarlo da un codice già esistente? Scusa ma forse mi perdo qualcosa

[Flash30005]

quelle 4 cifre in realtà sono solo 4 codici ovvero colonna A ha:
2058
3058
2558
3558

ora mi domando occorrono 128 righe per determinare uno dei 4 codici?

Qualcuno in più, forse, sulla colonna B (11 credo) per 516 righe
2450
2550
1250
2700
2800
1500
3000
2900
3200
3300
3400

Le colonne C, D, E, F mi sembrano proprio inutili

ciao

[3olo]

Hai ragione,ma questo database sarà un po' dinamico diciamo,verrà ampliato anche con nuovi codici e numeri,quindi se riesco a creare un qualcosa che riesca a estrapolare da questo contenitore sarei più contento. Siccome ci capisco poco tu l'hai progettata in questo modo,vero?

[3olo]

Mi potresti spiegare anche questo passaggio per favore?
-If StrDb Like "*" & StCo & "*" Then

[Flash30005]

Ho verificato il problema del codice SR
ed effettivamente essendo completamente diverso rispetto a WA e non avendo un esempio di come doveva essere
la macro non compilava il relativo codice.
quindi ripropongo la macro modificata

Codice: Seleziona tutto

Sub TRCodici()

Dim FS As Worksheet
Set FS = Sheets("selezione")
FS.Range("B39:B44").ClearContents
For CC = 1 To 6
    If CC = 5 And UCase(Right(FS.Range("D27"), 3)) = "000" Then GoTo SaltaCC
    If CC = 6 Then
        If UCase(Right(FS.Range("D29"), 2)) = "WA" Then
            CC = CC + 1
        Else
            If UCase(Right(FS.Range("D29"), 2)) = "00" Then GoTo SaltaCC
        End If
    End If
    If CC = 3 Then
        If UCase(Right(FS.Range("D3"), 2)) = "XL" Then GoTo SaltaCC
        If UCase(Right(FS.Range("D13"), 1)) = "0" Then GoTo SaltaCC
    End If
    UR = Sheets("codici DB").Cells(Rows.Count, CC).End(xlUp).Row
 
Select Case CC
Case 1
    StCo = FS.Range("D5").Text & FS.Range("D7").Text & FS.Range("D9").Text & FS.Range("D11").Text
Case 2
    StCo = FS.Range("D5").Text & "_" & FS.Range("D17").Text & FS.Range("D19").Text & FS.Range("D21").Text & FS.Range("D23").Text
Case 3
    StCo = Left(FS.Range("D5").Text, 6) & "--" & Right(FS.Range("D5").Text, 2) & "_" & FS.Range("D11").Text
Case 4
    StCo = Left(FS.Range("D5").Text, 6) & "--" & Right(FS.Range("D5").Text, 2) & "----" & FS.Range("D13").Text & FS.Range("D15").Text
Case 5
    StCo = FS.Range("D5").Text
Case 6
    StCo = Left(FS.Range("D5").Text, 6) & "--" & FS.Range("D3").Text
Case 7
    StCo = Left(FS.Range("D5").Text, 3) & "-----" & FS.Range("D3").Text
End Select

    For RR = 1 To UR
        STrODB = Sheets("codici DB").Cells(RR, CC)
        StrDb = Replace(Replace(Replace(Replace(Replace(Replace(Replace(STrODB, "COVER_", ""), "ASSEMBLY_", ""), "LUCE_", ""), "EXPL_", ""), "BOX_", ""), "TIPO WA_", ""), "TIPO SR_", "")
        If StrDb Like "*" & StCo & "*" Then
        If CC = 1 Then FS.Range("B39").Value = Sheets("codici DB").Range("A" & RR).Value
        If CC = 2 Then FS.Range("B40").Value = Sheets("codici DB").Range("B" & RR).Value
        If CC = 3 Then FS.Range("B43").Value = Sheets("codici DB").Range("C" & RR).Value
        If CC = 4 Then FS.Range("B41").Value = Sheets("codici DB").Range("D" & RR).Value
        If CC = 5 Then FS.Range("B42").Value = Sheets("codici DB").Range("E" & RR).Value
        If CC > 5 Then FS.Range("B44").Value = Sheets("codici DB").Cells(RR, CC).Value
        Else
        GoTo saltaRR
        End If
saltaRR:
    Next RR
SaltaCC:
Next CC

End Sub

La macro è abbastanza "flessibile" e non ha bisogno di modifiche se la struttura dei dati rimane inalterata.
Possono aumentare il numero dei codici ovvero le righe nelle colonne da A a G senza dover intervenire.

ciao

P.S. mentre inviavo ho visto il quesito posto relativo alla funzione "Like"
in pratica effettua un controllo tra le due stringhe e Like sta per "Contiene"
Semplice no!?

[3olo]

Azz...sempre più dura! Ahaha !grazie mille! Il like controlla se ogni riga del foglio codiciDB contiene la stringa del case che stai analizzando...giusto? Ma perché hai messo "*" ?

[Flash30005]

La funzione like in verità è come dire "simile", assomiglia ma le due stringhe:
"altalena" e "alta"
non sono uguali quindi per estendere questa funzione si usano i caratteri jolly (*, ?, etc)
quindi devo mettere la condizione in questo modo
SE "altalena" like "alta*" then
Mettendo l'asterisco a destra avrò la condizione SI con tutte quelle parole che Iniziano per "alta..."
mettendo l'asterisco prima e dopo avrò la condizione SI con tutte le parole che Contengono "alta"

Nel caso specifico essendo "StCo" una variabile non posso racchiuderla tra gli apici altrimenti il Vba la vedrebbe come stringa appunto "StCo" quindi (asterisco stringa, concateno con &, StcO variabile e chiudo con & e asterisco)

If StrDb Like "*" & StCo & "*" Then

Ciao

[3olo]

....cristallino!! Grazie! Non pensare di essertela cavata ancora però,ahahah, vedrai che qualche cavolata mi viene ancora in mente ....ahahah

[3olo]

Ciao,
sto lavorando con quel foglio e va molto bene,però ho aggiunto una colonna da filtrare,allego file xls con un paio di note.
Il problema è che ho provato a fare la macro di estrazione ma non riesco a capire perchè non va,potete darci un occhio per favore?
Secondo me risolvete in un attimo.
So che il codice è componibile facilmente,ma vorrei che lo cercsse nel database,che così nel caso non lo trovi non lo immetta nella casella blu.
Vi ringrazio tanto
http://www.filedropper.com/filtroprova2

[Flash30005]

Ma dici di aver aggiunto una colonna e poi invii il file con una sola colonna
potrei realizzare la macro con i dati che hai inviato ora ma dopo avrai sia tu che noi a dover, eventualmente, adattare al precedente foglio.
Pertanto, invece di semplificare, ci complichi (e ti complichi) la vita.
Se, invece, vuoi una macro che estrapoli dalla colonna A del foglio "codici DB" il codice corrispondente con i soli dati che hai inviato
procederei dopo conferma ma poi mi asterrò ad effettuare modifiche per inserire il tutto su un progetto più ampio.

ciao

[3olo]

Ciao flash,ti ringrazio, ho messo solo la colonna a perché questo tipo di macro la userei su diversi fogli,per cui tale tipologia colonna si troverà ad essere in diverse posizioni. Quindi ho fatto apposta per avere il tutto in una macro dedicata,che poi arrangio io per ogni foglio. Ma cos'ha di sbagliato quella che ho fatto io?

[3olo]

grazie mille,ci ho studiato un po' su, ho trovato un paio di errori e ho risolto. Per completezza ecco il codice giusto,per te è sicuramente una cosa facilissima,ma a qualche "osso" come me magari può servire. Grazie mille ancora

Codice: Seleziona tutto

Sub pippo()
Dim FS As Worksheet
Set FS = Sheets("selezione")
FS.Range("B45").Value = ""
Cscal = 0
If UCase(Right(FS.Range("D31"), 2)) = "00" Then Exit Sub
 If UCase(Right(FS.Range("D31"), 2)) = "SR" Then
    Hscal = WorksheetFunction.Sum(Mid(FS.Range("B40"), 30, 4), 1800)
    Else
        If UCase(Right(FS.Range("D31"), 2)) = "WA" Then
    Hscal = WorksheetFunction.Sum(Mid(FS.Range("B40"), 30, 4), 1800, Mid(FS.Range("B39"), 25, 4))
End If
End If
Cscal = "SCALA_" & Hscal

IR = Sheets("codici DB").Cells(Rows.Count, 1).End(xlUp).Row
  For ff = 1 To IR
     STrOD = Sheets("codici DB").Cells(ff, 1)
     If STrOD Like "*" & Cscal & "*" Then
      FS.Range("B45").Value = Sheets("codici DB").Cells(ff, 1).Value
 
   End If
    Next ff


End Sub

[Flash30005]

Ottimo l'approccio e la soluzione adottata.

Non mi piace molto il dover modificare di volta in volta la macro per adattarla alla colonna che contiene quel codice, pertanto ho pensato a modificare la macro in maniera tale che cerchi la colonna che contiene la stringa "scala"

per fare questo dovrai aggiungere delle righe codice all'interno della tua macro

Codice: Seleziona tutto

End If  '<<<<< esistente
'------------ aggiungere da qui
UCC = Worksheets("codici DB").Cells(1, Columns.Count).End(xlToLeft).Column
For CC = 1 To UCC
MsgBox Worksheets("codici DB").Cells(1, CC).Value
If Worksheets("codici DB").Cells(1, CC).Value Like "SCALA*" Then
Col = CC
Exit For
End If
Next CC
'-------------- a qui in questo punto e poi modificare le tre righe indicate

Cscal = "SCALA_" & Hscal  '<<<< esistente

IR = Sheets("codici DB").Cells(Rows.Count, Col).End(xlUp).Row  '<<<< modificare 1 con la variabile colonna (Col)
 For ff = 1 To IR
 STrOD = Sheets("codici DB").Cells(ff, Col)  ''<<<< modificare 1 con la variabile colonna (Col)
 If STrOD Like "*" & Cscal & "*" Then
 FS.Range("B45").Value = Sheets("codici DB").Cells(ff, Col).Value  ''<<<< modificare 1 con la variabile colonna (Col)

 End If
 Next ff

Ciao

N.B. i codici e le formule vanno inserite nel tag "Code" dell'editor per rendere il post più leggibile ed evitare di trovarsi delle emoticon tipo questa al posto di 8 ) - questo "8" e ")" lo leggi perché ho lasciato uno spazio tra i due caratteri ma senza spazio vedresti l'emoticon

[3olo]

che bella soluzione la tua! Ottimo veramente, e molto comoda. Grazie mille,la provo volentieri!