Ciao nixio,
devo valorizzare il contenuto di una cella (RISULTATO) in base al contenuto delle informazioni riportate in tre campi distinti della stessa tabella ed una lista di valori che si trova in un altra tabella in base a dei criteri.
I criteri da utilizzare sono:
Il valore da riportare varia in base a questi criteri e secondo diverse priorità:
Innanzi tutto se il valore della cella nel "CAMPO13" è "descrizione3_campo13", nella rispettiva riga della colonna AH riporterò come RISULTATO "bloccato".
Solo se non viene soddisfatta questa condizione, verifico il valore del CAMPO14, se è uguale a "caso1", il RISULTATO da riportare nella riga della colonna AH sarà prioritariamente il contenuto della rispettiva cella del campo12 solo se questo è diverso da
vuoto e diverso da uno dei valori presenti nella tabella "valori esclusi", altrimenti dovrà essere riportato come RISULTATO il valore presente nel campo13, sempre nel caso in cui quest'ultimo sia diverso da vuoto e diverso da uno dei valori presenti nella
tabella "valori esclusi". Se non è possibile assegnare uno dei valori del campo12 o del campo13, il valore da riportare come RISULTATO sarà "valore assente".
In tutti i casi in cui il valore del CAMPO14 è diverso da "caso1", il RISULTATO da riportare nella riga della colonna AH sarà prioritariamente il contenuto della rispettiva cella del campo13, in seconda priorità il campo12 se il valore da riportare è vuoto
o presente nella solita lista di valori da escludere. A cascata se anche il campo12 è un risultato da escludere (perchè vuoto o compreso nella lista valori da escludere), riporterò "valore assente.
Ho provato a fare questo (ad esclusione della ricerca del valore nella tabella "valori da escludere") con il codice sotto riportato... non so come fare la verifica sulla tabella dei valori da escludere, il file di esempio è qui.
Inoltre questa operazione andrebbe fatta su una lista di oltre 400.000 righe ed ho paura che questa da me abbozzata sia una soluzione snella...
Public Sub m()
Dim wk As Workbook
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim lng As Long
Dim lUltRiga As Long
Dim Risultato As String
Dim valore1 As String
Dim valore2 As String
Dim condizione1 As String
Dim condizione2 As String
Set WB = ThisWorkbook
With WB
Set sh1 = .Worksheets("dati")
End With
With sh1
lUltRiga = Range("A" & Rows.Count).End(xlUp).Row
For lng = 2 To lUltRiga
condizione1 = Range("M" & lng).Value
condizione2 = Range("N" & lng).Value
valore1 = Range("L" & lng).Value
valore2 = Range("M" & lng).Value
If condizione1 = "descrizione3_campo13" Then
Risultato = "BLOCCATO"
Range("AH" & lng).Value = Risultato
GoTo fine
End If
If condizione2 = "caso1" Then
Risultato = valore1
If Risultato = "" Then
Risultato = valore2
If Risultato = "" Then
Risultato = "valore non valido"
Range("AH" & lng).Value = Risultato
End If
Range("AH" & lng).Value = Risultato
End If
Range("AH" & lng).Value = Risultato
End If
If condizione2 <> "caso1" Then
Risultato = valore2
If Risultato = "" Then
Risultato = valore1
If Risultato = "" Then
Risultato = "valore non valido"
Range("AH" & lng).Value = Risultato
End If
End If
Range("AH" & lng).Value = Risultato
End If
fine:
Next
End With
Set sh = Nothing
End Sub
Prova qualcosa del genere:
'=========>>
Option Explicit
Dim arrDati As Variant, arrEsclusi As Variant
Dim arrOut() As Variant
Dim i As Long
Dim bEscluso As Boolean, bVuoto As Boolean
Dim bAllocated As Boolean
'--------->>
Public Sub Tester()
Dim WB As Workbook
Dim SH_Dati As Worksheet, SH_Esclusi As Worksheet
Dim RngDati As Range, rngEsclusi As Range
Dim sStr12 As String, sStr13 As String
Dim j As Long, UB As Long, LRow As Long
Dim bFlag As Boolean, bFlag2 As Boolean
Const sFoglioDati As String = "Dati" '<<=== Modifica
Const sFoglioEsclusi As String = _
"ValoriNonSignificativi" '<<=== Modifica
Const iColonnaCampo12 As Long = 12 '<<=== Modifica
Const iColonnaCampo13 As Long = 13 '<<=== Modifica
Const iColonnaCampo14 As Long = 14 '<<=== Modifica
Const sCondizione1 As String = _
"descrizione3_campo13" '<<=== Modifica
Set WB = ThisWorkbook
With WB
Set SH_Dati = .Sheets(sFoglioDati)
Set SH_Esclusi = .Sheets(sFoglioEsclusi)
End With
With SH_Dati
LRow = LastRow(SH_Dati, .Columns("A:A"))
Set RngDati = .Range("A2:AH" & LRow)
End With
With SH_Esclusi
LRow = LastRow(SH_Esclusi, .Columns("A:A"))
Set rngEsclusi = .Range("A2:A" & LRow)
End With
arrDati = RngDati.Value
UB = UBound(arrDati)
arrEsclusi = rngEsclusi.Value
For i = 1 To UB
bAllocated = False
If arrDati(i, iColonnaCampo13) = sCondizione1 Then
arrDati(i, 34) = "bloccato"
Else
sStr12 = arrDati(i, 12)
sStr13 = arrDati(i, 13)
Select Case True
Case arrDati(i, 14) = "caso1"
arrDati(i, 34) = Risposta(sStr12, sStr13)
Case Else
arrDati(i, 34) = Risposta(sStr13, sStr12)
End Select
End If
Next i
ReDim arrOut(1 To UB, 1 To 1)
For j = 1 To UB
arrOut(j, 1) = arrDati(j, 34)
Next j
On Error GoTo XIT
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
RngDati.Columns(34).Value = arrOut
Call MsgBox( _
Prompt:="Finito!", _
Buttons:=vbInformation, _
Title:="REPORT")
XIT:
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
'--------->>
Public Function Risposta(aStr As String, bStr As String) As String
Dim Res As Variant, Res2 As Variant
Res = Application.Match(aStr, arrEsclusi, 0)
bEscluso = Not IsError(Res)
bVuoto = aStr = vbNullString
If Not bEscluso And Not bVuoto Then
Risposta = aStr
bAllocated = True
Else
Res2 = Application.Match(bStr, arrEsclusi, 0)
bEscluso = Not IsError(Res2)
bVuoto = bStr = vbNullString
If Not bEscluso And Not bVuoto Then
Risposta = bStr
bAllocated = True
End If
End If
If Not bAllocated Then
Risposta = "valore non valido"
End If
End Function
'--------->>
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
'<<=========
Postscriptum:
I risultati otttenuti da me con i tuoi dati erano tutti in accordo con quelli indicati da te come
atteso.
Ho anche provato il codice, estendendo i tuoi dati sino a 100.000 righe e, utilizzando il mio pc più vecchio, ci voleva circa 12 secondi. Visto che si trattava di una database di circa 3.500.000 celle e che il tuo compito sia mensile, questo tempo di esecuzione
non mi era molto preoccupante.
===
Regards,
Norman
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
