Home › Forum › Domande su Formule e Funzioni › [RISOLTO] Lettera colonna › Rispondi a: [RISOLTO] Lettera colonna
Una soluzione anche lato vba (visto che l’avevo iniziata)
Sicuramente migliorabile
Sub LETTERE()
Dim ws As Worksheet
Dim nRiga As Long, j As Long, k As Long
Dim rTab As Range, rUcella As Range, cella As Range
Dim firstAddress As String, x As String
Dim vArr() As Variant
Dim n As Integer
Set ws = Sheets("F2") 'nome tuo foglio
nRiga = ws.Range("I" & Rows.Count).End(xlUp).Row
Set rTab = ws.Range("I12:EXI" & nRiga)
ReDim vArr(1 To rTab.Rows.Count, 1 To 5)
Set rUcella = rTab(rTab.Rows.Count, rTab.Columns.Count)
With rTab
Set cella = .Find(2, rUcella, xlValues, xlWhole, xlByRows, xlNext)
If Not cella Is Nothing Then
firstAddress = cella.Address
Do
j = cella.Row - rTab.Row + 1
x = Replace(ws.Cells(1, cella.Column).Address(False, False), "1", "")
n = IIf(j = k, n + 1, 1)
k = j
vArr(cella.Row - rTab.Row + 1, n) = x
Set cella = .FindNext(cella)
Loop While Not cella Is Nothing And cella.Address <> firstAddress
End If
End With
ws.Range("A12:E" & Rows.Count).ClearContents
ws.Range("A12:E" & nRiga).Value = vArr
Set ws = Nothing
Set rTab = Nothing
Set rUcella = Nothing
End Sub