Ciao Stefano,
l'output che vorrei ottenere è la compilazione automatica della colonna chiamata "padre" così come la vedi nella tabella di esempio che ho inserito io. Come input darò le colonne livello e identifier e come output voglio ottenere la colonna padre.
In un modulo standard, prova qualcosa del genere:
'=========>>
Option Explicit
'--------->>
Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim RngDati As Range, RngLivelli As Range
Dim arrDati As Variant, arrUniqueLevels As Variant
Dim arrLivelli() As Variant
Dim arrOut As Variant
Dim Res As Variant
Dim i As Long, j As Long, k As Long
Dim LRow As Long, UB As Long
Const sFoglio As String = "Foglio1" '<<=== Modifica
Set WB = ThisWorkbook
Set SH = WB.Sheets(sFoglio)
With SH
LRow = LastRow(SH, .Columns("A:A"))
Set RngLivelli = .Range("A2:A" & LRow)
Set RngDati = RngLivelli.Resize(, 2)
End With
arrDati = RngDati.Value2
UB = UBound(arrDati)
arrLivelli = RngLivelli.Value2
arrUniqueLevels = SortedUniqueList(arrLivelli)
ReDim Preserve arrLivelli(1 To UB, 1 To 2)
ReDim arrOut(1 To UB, 1 To 1)
For i = 1 To UB
Res = Application.Match(arrDati(i, 1), arrUniqueLevels, 0)
RngLivelli.Cells(i).Select
If arrDati(i, 1) = 1 Then
arrLivelli(i, 2) = arrDati(i, 2)
Else
arrLivelli(Res, 2) = arrDati(i, 2)
arrOut(i, 1) = arrLivelli(Res - 1, 2)
End If
Next i
On Error GoTo XIT
Application.ScreenUpdating = False
RngLivelli.Offset(, 2).Value = arrOut
XIT:
Application.ScreenUpdating = True
End Sub
'--------->>
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 SortedUniqueList(V As Variant)
Dim oSortedUniqueList As Object
Dim arrOut() As Variant
Dim vVal As Variant
Dim i As Long
Set oSortedUniqueList = CreateObject("System.Collections.Sortedlist")
With oSortedUniqueList
For i = LBound(V) To UBound(V)
vVal = V(i, 1)
If Not IsEmpty(vVal) Then
If Not .ContainsKey(vVal) Then
.Add Key:=vVal, Value:=i
End If
End If
Next i
ReDim arrOut(1 To .Count)
For i = 0 To .Count - 1
arrOut(i + 1) = .GetKey(i)
Next i
End With
SortedUniqueList = arrOut
End Function
'<<=========
===
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)
