Rispondi a: [RISOLTO] Lettera colonna

[sidModeratore 22 Settembre 2018 alle 19:20 Post totali: 716]

#6680

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