![](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)
Microsoft 365 e Office | Excel | Per la casa | Windows
Una famiglia di software per fogli di calcolo Microsoft con strumenti per l'analisi, la creazione di grafici e la comunicazione dei dati.
Ciao Davide,
Grazie Norman per la cortesia funzionano benissimo.
Sei un master!!!!
Ti ringrazio per il cortese riscontro e approfittp per precisare che la terza formula, ossia:
L7: =INDICE(DATI!$A$7:$IC$659;CONFRONTA(F7;DATI!$F$7:$F$659;0);107)
avrebbe dovuto essere:
=INDICE(DATI!$A$7:$IC$659;CONFRONTA(F7;DATI!$F$7:$F$659;0);109)
Giusto per conoscenza.......fare una macro che ottenga lo stesso risultato sarebbe molto complicato?
Se non hai tempo non importa figurati.
Grazie comunque.
In un modulo standard, prova qualcosa del genere:
'=========>>
Option Explicit
'--------->>
Public Sub Tester()
Dim WB As Workbook
Dim SH_DATI As Worksheet, SH_PRONO As Worksheet
Dim rDATI As Range, rDestinazione As Range
Dim rCasa_DATI As Range, rOspite_DATI As Range
Dim rCasa_PRONO As Range, rOspite_PRONO As Range
Dim arrDATI As Variant, arrRisposte() As Variant
Dim arrCasa_DATI As Variant, arrOspite_DATI As Variant
Dim arrCasa_PRONO As Variant, arrOspite_PRONO As Variant
Dim sCasa As String, sOspite As String
Dim iRow As Long, jRow As Long
Dim iCol As Long
Dim i As Long
Dim pRow As Long, qRow As Long
Dim UB As Long
Dim CalcMode As XlCalculation
Dim ViewMode As XlWindowView
Const sFoglioSorgente As String = "DATI" '<<=== Modifica
Const sFogliodDestinazione As String = "PRONO" '<<=== Modifica
Const iPrimaRigaDATI As Long = 7 '<<=== Modifica
Const sColonneDestinazione As String = "J:M" '<<=== Modifica
Const sColonnaCasa As String = "E" '<<=== Modifica
Const sColonnaOspite As String = "F" '<<=== Modifica
Set WB = ThisWorkbook
With WB
Set SH_DATI = .Sheets(sFoglioSorgente)
Set SH_PRONO = .Sheets(sFogliodDestinazione)
End With
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
With SH_DATI
iRow = LastRow(SH_DATI, .Columns("A:A"))
iCol = LastCol(SH_DATI, .Rows(iPrimaRigaDATI - 2))
Set rDATI = .Range("A" & iPrimaRigaDATI). _
Resize(iRow - iPrimaRigaDATI + 1, iCol)
Set rCasa_DATI = rDATI.Columns(sColonnaCasa)
Set rOspite_DATI = rDATI.Columns(sColonnaOspite)
End With
With SH_PRONO
jRow = LastRow(SH_PRONO, .Columns("A:A"))
UB = jRow - iPrimaRigaDATI + 1
Set rDestinazione = .Range(sColonneDestinazione). _
Resize(UB).Offset(iPrimaRigaDATI - 1)
Set rCasa_PRONO = .Columns(sColonnaCasa).Resize(UB). _
Offset(iPrimaRigaDATI - 1)
Set rOspite_PRONO = rCasa_PRONO.Offset(0, 1)
End With
arrDATI = rDATI.Value
arrCasa_DATI = rCasa_DATI.Value
arrOspite_DATI = rOspite_DATI.Value
arrCasa_PRONO = rCasa_PRONO.Value
arrOspite_PRONO = rOspite_PRONO.Value
ReDim arrRisposte(1 To UB, 1 To 4)
For i = 1 To UB
sCasa = arrCasa_PRONO(i, 1)
sOspite = arrOspite_PRONO(i, 1)
pRow = MatchRow(arrCasa_DATI, sCasa)
If CBool(pRow) Then
arrRisposte(i, 1) = arrDATI(pRow, 76)
arrRisposte(i, 2) = arrDATI(pRow, 10)
End If
qRow = MatchRow(arrOspite_DATI, sOspite)
If CBool(qRow) Then
arrRisposte(i, 3) = arrDATI(qRow, 109)
arrRisposte(i, 4) = arrDATI(qRow, 43)
End If
Next i
rDestinazione.Value = arrRisposte
Call MsgBox( _
Prompt:="Fatto!", _
Buttons:=vbInformation, _
Title:="REPORT")
XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
ActiveWindow.View = ViewMode
End Sub
'--------->>
Public Function MatchRow(arrIn As Variant, sStr As String) As Long
Dim i As Long
For i = LBound(arrIn) To UBound(arrIn)
If arrIn(i, 1) = sStr Then
MatchRow = i
Exit For
End If
Next i
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
'--------->>
Public Function LastCol(SH As Worksheet, _
Optional Rng As Range, _
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
LastCol = Rng.Find(What:="*", _
after:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
If bProtected Then
SH.Protect Password:=sPassword, _
UserInterfaceOnly:=True
End If
End Function
'<<=========
===
Regards,
Norman