compilare una tabella controllando dati in piu fogli

[raimea]

buona sera
questa volta e' davvero difficile x me...

in un foglio (8-rendita-singola)avrei bisogno di una macro che dovrebbe cercare la
squadra che si mette in B3 , cercandola in fg5 colonne F e H
se la trova controlla l'esito V o P, - dopodiche' va in fgl 1
sulla stessa riga del fg5 trovera' la stessa partita
li dovrebbe prendere i dati x compilare questa tabella.

SE in fg5 ha trovato una V vincita, trova il dato da riportare in fg 1 col L
se in fg5 ha trovato una P la perdita, trova il dto da riportare in fg 1 col N

uno dei problemi potrebbe essere che la stessa squadra ha fatto piu partite
che dovrebbero essere riportate tutte nella tabella.

la macro andrebbe fatta partire da un pulsante dopo aver selez la squadra .

ovviamente vista la complessita allego il file x chi vuole avventurarsi...

http://rapidshare.com/files/380475697/pcf.luga-U.O.zip.html

[Flash30005]

Questa macro risolve in parte il tuo quesito

Codice: Seleziona tutto

Sub AttrVinc()
URV = Range("B" & Rows.Count).End(xlUp).Row
SQ = Range("B3").Text
UR5 = Worksheets("5-Squadre").Range("E" & Rows.Count).End(xlUp).Row
8 I = 7
For Col5 = 6 To 8 Step 2
    For RS = 9 To UR5
        SQ5 = Worksheets("5-Squadre").Cells(RS, Col5).Value
        If SQ5 = SQ Then
            ValP = Worksheets("5-Squadre").Range("J" & RS).Text
            Data1 = Worksheets("1-luga.uo-Fogl.Base").Range("C" & RS).Text
            Part1 = Worksheets("1-luga.uo-Fogl.Base").Range("G" & RS).Text
            Col8 = "F"
            Col1 = "L"
            If ValP = " p " Then
                Col8 = "G"
                Col1 = "N"
                GoTo SaltaS
            End If
        End If
    Next RS
Next Col5
SaltaS:
For RR = 7 To URV
    If Range("B" & RR).Value = SQ Then
        Range("D" & RR).Value = Data1
        Range("E" & RR).Value = Part1
        Range(Col8 & RR).Value = Worksheets("1-luga.uo-Fogl.Base").Range(Col1 & RS).Value
    End If
Next RR
End Sub


perché:

uno dei problemi potrebbe essere che la stessa squadra ha fatto piu partite
che dovrebbero essere riportate tutte nella tabella.

Ma se nella tabella c'è riportata solo una voce di quella squadra dove dovrebbero essere inseriti gli altri risultati?

Ciao

P.s. Attivare la macro dal foglio "8-rendita-singola"

[raimea]

ho provato la macro ed in parte fa come vorrei.

Ma se nella tabella c'è riportata solo una voce di quella squadra dove dovrebbero essere inseriti gli altri risultati?

io vorrei che tutte le partite della stessa squadra selezionata venissero riportate in colonna E una sotto l'altra.
poi ad ogni nuova ricerca la tabella dovrebbe venire pulita.
al momento la macro non riporta gli importi di fgl1 col L o N...
ringrazio

[Flash30005]

Prova questa macro

Codice: Seleziona tutto

Sub AttrVinc()
URV = Range("E" & Rows.Count).End(xlUp).Row
If URV < 7 Then URV = 7
Range("D7:G" & URV).ClearContents
SQ = Range("B3").Text
UR5 = Worksheets("5-Squadre").Range("E" & Rows.Count).End(xlUp).Row
8 I = 7
For Col5 = 6 To 8 Step 2
    For RS = 9 To UR5
        SQ5 = Worksheets("5-Squadre").Cells(RS, Col5).Value
        If SQ5 = SQ Then
            ValP = Worksheets("5-Squadre").Range("J" & RS).Text
            Data1 = Worksheets("1-luga.uo-Fogl.Base").Range("C" & RS).Text
            Part1 = Worksheets("1-luga.uo-Fogl.Base").Range("G" & RS).Text
            Col8 = "F"
            Col1 = "L"
            If ValP = " p " Then
                Col8 = "G"
                Col1 = "N"
                'GoTo SaltaS
            End If
            URV = Range("E" & Rows.Count).End(xlUp).Row + 1
            Range("B" & URV).Value = SQ
            Range("D" & URV).Value = Data1
            Range("E" & URV).Value = Part1
            Range(Col8 & URV).Value = Worksheets("1-luga.uo-Fogl.Base").Range(Col1 & RS).Value
        End If
    Next RS
Next Col5
End Sub

Poi nel foglio inserisci questo codice

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$3" Then Exit Sub
AttrVinc
End Sub


Al variare della squadra avrai i dati partita/e in tabella

Se dovessi incontrare problemi scarica questo file

Ciao

[raimea]

okk
fino a qui funziona tutto come desideravo.

rimane una piccola cosina da sistemare.

quando si selez la squadra in fgl8 in colonna B3, la tabella si compila correttamente.
ma in Col B da riga 7 in giu si ripete la stessa squadra x il numero di volte che viene trovata
se possibile mi servirebbe riportare poi la col B da riga 7 con l'elenco delle squadre iniziali...

[raimea]

provate il tes della data con questo file con piu dati caricati
provate a selez in fgl8 - inter

in fgl8 dalla riga D9 in giu' dove c'e la data
scrive mese-giorno-anno anzzicche giorno-mese-anno ...

http://rapidshare.com/files/380830011/Copia_di_luga-U.O.zip.html

[Flash30005]

Nella macro "AttrVinc"
modifica la riga evidenziata tra queste:

Codice: Seleziona tutto

            URV = Range("E" & Rows.Count).End(xlUp).Row + 1
            Range("B" & URV).Value = SQ
            Range("D" & URV).Value = DateSerial(Year(Data1), Month(Data1), Day(Data1))  '<<<<< modificare così
            Range("E" & URV).Value = Part1
            Range(Col8 & URV).Value = Worksheets("1-luga.uo-Fogl.Base").Range(Col1 & RS).Value


Il resto lascia tutto invariato

Ciao

[raimea]

ottimo
problema data risolta
grazie fessss

[raimea]

mi sento in dovere di mettere a disposizione di tutti gli utenti di questo sito il mio file.
dopotutto per le macro piu complesse se non fosse stato x l'aiuto ottenuto qui... (me le hanno fatte...)
ringrazio nuovamente tutti gli amministratori del sito
grazie

http://rapidshare.com/files/381034957/pcf-luga-U.O.zip.html

[raimea]

ho voluto provare a modific la macro in modo da compilare in fgl8 altre 2 colonne la H e la I
in fgl8 H volevo riportare i dati del fg1 in col J
in fgl8 I volevo riportare i dati del fgl1 in col O

i dati vengono si riportati in fgl8 ma alle righe sbagliete ....
che sbaglio ?

Codice: Seleziona tutto

Sub AttrVinc()
Worksheets("8-rendita-singola").Unprotect
Application.ScreenUpdating = False


URV = Range("E" & Rows.Count).End(xlUp).Row
If URV < 7 Then URV = 7
Range("D7:I" & URV).ClearContents
SQ = Range("B3").Text
UR5 = Worksheets("5-Squadre").Range("E" & Rows.Count).End(xlUp).Row
8 I = 7
For Col5 = 6 To 8 Step 2
    For RS = 9 To UR5
        SQ5 = Worksheets("5-Squadre").Cells(RS, Col5).Value
        If SQ5 = SQ Then
            ValP = Worksheets("5-Squadre").Range("J" & RS).Text
            Data1 = Worksheets("1-luga.uo-Fogl.Base").Range("C" & RS).Text
            Part1 = Worksheets("1-luga.uo-Fogl.Base").Range("G" & RS).Text
            Part2 = Worksheets("1-luga.uo-Fogl.Base").Range("j" & RS).Text
            Part3 = Worksheets("1-luga.uo-Fogl.Base").Range("o" & RS).Text
            Col8 = "F"
            Col1 = "L"
            If ValP = " p " Then
                Col8 = "G"
                Col1 = "N"
                'GoTo SaltaS
            End If
            URV = Range("E" & Rows.Count).End(xlUp).Row + 1
            Range("B" & URV).Value = SQ
            Range("D" & URV).Value = DateSerial(Year(Data1), Month(Data1), Day(Data1))  '<<<<< modificare così
            Range("E" & URV).Value = Part1
            Range("h" & URV).Value = Part2
            Range("I" & URV).Value = Part3
            Range(Col8 & URV).Value = Worksheets("1-luga.uo-Fogl.Base").Range(Col1 & RS).Value

        End If
       Range("B7").Select
    ActiveCell.FormulaR1C1 = "='6-Squadre.Alfabeto'!R[1]C[1]"
    Range("B7").Select
    ActiveCell.FormulaR1C1 = "=UPPER('6-Squadre.Alfabeto'!R[1]C[1])"
    Range("B7").Select
    Selection.AutoFill Destination:=Range("B7:B39"), Type:=xlFillDefault
    Range("B7:B39").Select
    ActiveWindow.SmallScroll Down:=-33
    Range("D7:G35").Select
    Selection.Sort Key1:=Range("D7"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    ActiveWindow.SmallScroll Down:=-18
    Range("I3").Select
    Next RS
Next Col5

ActiveWindow.DisplayGridlines = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True


End Sub

[raimea]

trovato l'errore
riporto la riga incriminata scritta correttamente...

Range("D7:I35").Select <<< cosi e' scritta giusta

riguarda l'ordinamento finale in ordine di data crecente

[raimea]

ho inserito un nuovo foglio (fgl9)
molto simile al fgl 8
nel foglio 9 rend-naz dovrei compilare una tabella come nel fgl8
ho provato a riportare la macro "attrvinc"
in macro "rendnaz"
ed a modificarla maa..... non ci riesco...
la macro dovrebbe:
cercare la nazione in fg5 (oppure 1)
e compilare la stessa tabella come in fgl8....

ovviamente allego il file..

ringrazio
anticipatamente tutti

http://rapidshare.com/files/384233314/xsito-luga-U.O.zip.html

[Flash30005]

Era sufficiente riportare il codice che è nel foglio 8... anche nel foglio 9....

e togliere la protezione anche al foglio 9 nella macro "attrvinc"

e usare la stessa macro

Ti rispedisco il file
http://rapidshare.com/files/384292153/xsito-luga-U.O.rar.html

Ciao

[raimea]

azz
forse mi sono spiegato male
nl fgl9 dovrei creare la tabelle ma selezionando le NAZIONI
non piu la singola squadra (vedi fgl

[Flash30005]

Ma l'elenco che hai nel foglio 9 da te inviato ci sono le squadre
se ti va bene creiamo un elenco nazioni

Fai sapere

ciao

[raimea]

cavolo allora ho sbagliato ad allegare il file

lo rimetto ... giusto..

http://rapidshare.com/files/384592565/pove9-luga-U.O.zip.html

si in fgl9 col B, ci deve esere un elenco nazioni ( prese dal fgl5 col R)
poi in fgl 9 in base alla nazione scelta , mi va a compilare la relativa tabella (come in fgl.8 )

- le nazioni possono essere cercate sia in fgl1 col F oppure in fgl 5 col K

ora nel file c'e una macro "rendnaz" che ho tentato di adattare al fgl9 ma non funziona correttamente
sicuramente c'e qualche errore che il/i professori potranno trovare...
( se seles Comp.eur. la macro funziona se selez italy non va.. )

ringrazio

[raimea]

risolto il problemino....

era dovuto al fatto che in fgl9 col B alcune nazioni era scritte con l'iniziale maiuscola e non come in fgl5 col K

ecco la macro

Sub rendnaz()
Worksheets("9-rend-naz").Unprotect
Application.ScreenUpdating = False
URV = Range("E" & Rows.Count).End(xlUp).Row
If URV < 7 Then URV = 7
Range("D7:k" & URV).ClearContents
SQ = Range("B3").Text
UR5 = Worksheets("5-Squadre").Range("E" & Rows.Count).End(xlUp).Row
8 I = 7
For Col5 = 6 To 11 Step 5
For RS = 9 To UR5
SQ5 = Worksheets("5-Squadre").Cells(RS, Col5).Value
If SQ5 = SQ Then
ValP = Worksheets("5-Squadre").Range("J" & RS).Text
Data1 = Worksheets("1-luga.uo-Fogl.Base").Range("C" & RS).Text
Part1 = Worksheets("1-luga.uo-Fogl.Base").Range("G" & RS).Text
Part2 = Worksheets("1-luga.uo-Fogl.Base").Range("j" & RS).Text
Part3 = Worksheets("1-luga.uo-Fogl.Base").Range("o" & RS).Text
Part4 = Worksheets("1-luga.uo-Fogl.Base").Range("M" & RS).Text
Part5 = Worksheets("1-luga.uo-Fogl.Base").Range("F" & RS).Text
Col8 = "F"
Col1 = "L"
If ValP = " p " Then
Col8 = "G"
Col1 = "N"
'GoTo SaltaS
End If
URV = Range("E" & Rows.Count).End(xlUp).Row + 1
Range("B" & URV).Value = SQ
Range("D" & URV).Value = DateSerial(Year(Data1), Month(Data1), Day(Data1))
Range("E" & URV).Value = Part1
Range("h" & URV).Value = Part2
Range("I" & URV).Value = Part3
Range("J" & URV).Value = Part4
Range("K" & URV).Value = Part5
Range(Col8 & URV).Value = Worksheets("1-luga.uo-Fogl.Base").Range(Col1 & RS).Value

End If
ActiveSheet.Unprotect
Range("B7").Select
ActiveCell.FormulaR1C1 = "='1-luga.uo-Fogl.Base'!R[-4]C[28]"
Range("B7").Select
Selection.AutoFill Destination:=Range("B7:B33"), Type:=xlFillDefault
Range("B7:B33").Select
ActiveWindow.SmallScroll Down:=-21
Range("A3").Select



Next RS
Next Col5

ActiveWindow.DisplayGridlines = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, AllowFormattingRows:=True


End Sub

[Flash30005]

Sono contento che hai risolto!!!

Non ho avuto ancora il tempo di vedere l'ultimo file da te inviato
comunque, quando hai caratteri maiuscoli e minuscoli
è sufficiente mettere in una macro la funzione Ucase
es.:
se hai il dato origine scritto
Pippo
e dato confronto pippo o PIPPO (o comunque scritto)
nella condizione (If)
metterai
if Ucase(DatoOrigine) = Ucase(DatoConfronto) then ...
fai quello che vuoi

Ciao

[raimea]

Grazie Fesss... del suggerimento
io non conoscevo questo comando
eccolo applicato alla macro sopra

Codice: Seleziona tutto

 If UCase(SQ5) = UCase(SQ) Then

funziona alla grande
di nuovo grazie a tutti

[Flash30005]

Grazie Fesss... ........