Confronto presenza valore in tabelle

[azalynPartecipante azalyn]

Inizio subito dicendo che allego il file per cercare di semplificare il tutto e esporre al meglio il mio problema e come vorrei che fosse risolto.
Ho i seguenti fogli Barbaro, Barbaro2 e mod.
Mi servirebbe una formula (che andrebbe messa in barbaro2 nelle righe delle capacitá speciali) che permetta di fare un confronto fra : presenza dei valore contenuti nelle celle Barbaro!d41:d68 + le celle  Barbaro!l41:l68 con i valori delle 10 tabelle hanno tutte le intestazioni in Mod:l1:x87

 

[Luca73Partecipante Luca73 Karma: 58 pts]

Io non vedo l'allegato.

Ciao

Luca

[azalynPartecipante azalyn]

non so il motivo perche non me lo alleghi, passo l'url di megahttps://mega.nz/#!fU1TCb5C!4CGhLjvsgBosW0IQKdQvaYAzWLMujfgydKhT-I8EC48

[Luca73Partecipante Luca73 Karma: 58 pts]

Ciao Giusto Per Capire

Se nel folgio Barbaro nella classe C'è scritto Barbaro con livello 3

to voi che nelle capacitá speciali compaiano 

- Movimento veloce, analfabetismo, ira 1 volta al giorno

- Schivare prodigioso

- Percepire trappole + 1

Corretto?

Domanda puoi avere più di una classe?

Ciao

Luca

[azalynPartecipante azalyn]

si esatto, ma visto che c'é la possibilitá di avere piu classi in contemporanea la cosa la rende un po piu complicata. 

[Luca73Partecipante Luca73 Karma: 58 pts]

Con Formula non penso si possa, o meglio io non so come fare.

Lo risoverei con una macro.

Prova a vedere se la macro qui sotto fa al caso tuo

Sub Luca()
Dim Indice As Integer
Dim Indice01 As Integer
Dim Indice02 As Integer
Dim Vettore(1 To 10, 1 To 2)
Dim Risultati(1 To 10, 1 To 2)
Dim CellaW

If MsgBox("proseguo aggiornando e cancellando?", vbQuestion + vbYesNo, "CANCELLO?") = vbNo Then Exit Sub
ActiveWorkbook.Sheets("Barbaro2").Range("H4:L51").ClearContents
Risultati(1, 1) = "Barbaro"
Set Risultati(1, 2) = ActiveWorkbook.Sheets("mod").Range("L2:L21")
Risultati(2, 1) = "Guerriero"
Set Risultati(2, 2) = ActiveWorkbook.Sheets("mod").Range("L24:L43")
Risultati(3, 1) = "Monaco"
Set Risultati(3, 2) = ActiveWorkbook.Sheets("mod").Range("L46:L65")
Risultati(4, 1) = "Stregone"
Set Risultati(4, 2) = ActiveWorkbook.Sheets("mod").Range("L68:L87")
Risultati(5, 1) = "Bardo"
Set Risultati(5, 2) = ActiveWorkbook.Sheets("mod").Range("O2:O21")
Risultati(6, 1) = "Ladro"
Set Risultati(6, 2) = ActiveWorkbook.Sheets("mod").Range("O24:O43")
Risultati(7, 1) = "Paladino"
Set Risultati(7, 2) = ActiveWorkbook.Sheets("mod").Range("O45:O65")
Risultati(8, 1) = "Druido"
Set Risultati(8, 2) = ActiveWorkbook.Sheets("mod").Range("R2:R21")
Risultati(9, 1) = "Mago"
Set Risultati(9, 2) = ActiveWorkbook.Sheets("mod").Range("R24:R43")
Risultati(10, 1) = "Ranger"
Set Risultati(10, 2) = ActiveWorkbook.Sheets("mod").Range("R46:R65")

For Indice = 1 To 10
    Vettore(Indice, 1) = ActiveWorkbook.Sheets("Barbaro").Range("C38").Offset((Indice) * 3, 1)
    Vettore(Indice, 2) = ActiveWorkbook.Sheets("Barbaro").Range("C38").Offset((Indice) * 3, 9)
    If Not IsNumeric(Vettore(Indice, 2)) Then
        MsgBox "livello non numerico"
        Exit Sub
    End If
Next Indice

For Indice01 = 1 To 10
    For Indice02 = 1 To 10
        If Risultati(Indice01, 1) = Vettore(Indice02, 1) Then
            For Each CellaW In Risultati(Indice01, 2)
                If CellaW.Value < = Vettore(Indice02, 2) Then
                    If CellaW.Offset(0, 1) <> "" Then
                        ActiveWorkbook.Sheets("Barbaro2").Range("H52").End(xlUp).Offset(1, 0).Select
                        ActiveWorkbook.Sheets("Barbaro2").Range("H52").End(xlUp).Offset(1, 0) = CellaW.Offset(0, 1).Text
                    End If
                End If
            Next CellaW
        End If
    Next Indice02
Next Indice01

MsgBox "Finito"
End Sub

 

[azalynPartecipante azalyn]

L'ho provata utilizzando solo guerriero lv1 ed é andata, poi guerriero 1+paladino3 e da li in poi mi ha continuato a dare errore runtime 1004 errore defiito dall'applicazione o dall'oggetto

 

[Luca73Partecipante Luca73 Karma: 58 pts]

Errore mio.

ho lasciato una riga usata per il debug.

Prova a commentare(anteponi un apice) oppure cancellare la riga

ActiveWorkbook.Sheets("Barbaro2").Range("H52").End(xlUp).Offset(1, 0).Select

[azalynPartecipante azalyn]

La macro funziona perferttamente ma si potrebbe rendere automatizzata la macro senza gli msgbox?

OT Ma i  che mi compaiono nelle mie risposte a cosa sono dovuti?

[Luca73Partecipante Luca73 Karma: 58 pts]

Ciao

Riguardo alla prima domanda, basta cancellare le relative istruzioni 

If MsgBox("proseguo aggiornando e cancellando?", vbQuestion + vbYesNo, "CANCELLO?") = vbNo Then Exit Sub

e

MsgBox "Finito"

Riguardo alla seconda è un problema del Forum....

Potresti poi automatizzare il tutto in modo che si avvii in automatico quando cabli una delle celle interessate (classe o livello) in Barbaro 

 

fammi sapere se funziona.

Ciao

Luca

 

[azalynPartecipante azalyn]

Ho provato a fare questa modifica per tentare di renderla automatica ma non funziona. Idee? Ps. nello stesso foglio macro c'é un'altra macro sempre worksheet_change che mi svolge un altra funzione
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Indice As Integer Dim Indice01 As Integer Dim Indice02 As Integer Dim Vettore(1 To 10, 1 To 2) Dim Risultati(1 To 10, 1 To 2) Dim CellaW Dim myTab19 As String myTab19 = "L41:R69"
If Not Application.Intersect(Target, Range(myTab19)) Is Nothing And Sheets("Barbaro").Range("b8").Value <> 0 Then ActiveWorkbook.Sheets("Barbaro2").Range("H4:L51").ClearContents Risultati(1, 1) = "Barbaro" Set Risultati(1, 2) = ActiveWorkbook.Sheets("mod").Range("L2:L21") Risultati(2, 1) = "Guerriero" Set Risultati(2, 2) = ActiveWorkbook.Sheets("mod").Range("L24:L43") Risultati(3, 1) = "Monaco" Set Risultati(3, 2) = ActiveWorkbook.Sheets("mod").Range("L46:L65") Risultati(4, 1) = "Stregone" Set Risultati(4, 2) = ActiveWorkbook.Sheets("mod").Range("L68:L87") Risultati(5, 1) = "Bardo" Set Risultati(5, 2) = ActiveWorkbook.Sheets("mod").Range("O2:O21") Risultati(6, 1) = "Ladro" Set Risultati(6, 2) = ActiveWorkbook.Sheets("mod").Range("O24:O43") Risultati(7, 1) = "Paladino" Set Risultati(7, 2) = ActiveWorkbook.Sheets("mod").Range("O45:O65") Risultati(8, 1) = "Druido" Set Risultati(8, 2) = ActiveWorkbook.Sheets("mod").Range("R2:R21") Risultati(9, 1) = "Mago" Set Risultati(9, 2) = ActiveWorkbook.Sheets("mod").Range("R24:R43") Risultati(10, 1) = "Ranger" Set Risultati(10, 2) = ActiveWorkbook.Sheets("mod").Range("R46:R65") For Indice = 1 To 10 Vettore(Indice, 1) = ActiveWorkbook.Sheets("Barbaro").Range("C38").Offset((Indice) * 3, 1) Vettore(Indice, 2) = ActiveWorkbook.Sheets("Barbaro").Range("C38").Offset((Indice) * 3, 9) If Not IsNumeric(Vettore(Indice, 2)) Then MsgBox "livello non numerico" Exit Sub End If Next Indice For Indice01 = 1 To 10 For Indice02 = 1 To 10 If Risultati(Indice01, 1) = Vettore(Indice02, 1) Then For Each CellaW In Risultati(Indice01, 2) If CellaW.Value < = Vettore(Indice02, 2) Then If CellaW.Offset(0, 1) <> "" Then ActiveWorkbook.Sheets("Barbaro2").Range("H52").End(xlUp).Offset(1, 0) = CellaW.Offset(0, 1).Text End If End If Next CellaW End If Next Indice02 Next Indice01 End If End Sub

[azalynPartecipante azalyn]

disastro.

[azalynPartecipante azalyn]

Ok, sono riuscito a renderla automatica ma quando vado ad inserire nuovi classi+livelli continua ad aggiungere voci gia inserite in precedenza ( https://pastebin.com/Swp7S4XC )
PS. Ho risolto inserendola in una macro worksheet_change gia esistente

[Luca73Partecipante Luca73 Karma: 58 pts]

Ciao Mi sembra manchi la riga

ActiveWorkbook.Sheets("Barbaro2").Range("H4:L51").ClearContents

che era all'inizio dopo il primo msgbox.

Questa riga cancella tutto prima di riscrivere.

Ciao

[Autore]

Articoli