You are here:---Rispondi a: [RISOLTO] Lettera colonna
Rispondi a: [RISOLTO] Lettera colonna2018-09-22T19:20:21+02:00

Home Forum Domande su Formule e Funzioni [RISOLTO] Lettera colonna Rispondi a: [RISOLTO] Lettera colonna

sidsid
Moderatore
    Post totali: 716

    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

    Utilizzando il sito, accetti l'utilizzo dei cookie da parte nostra. maggiori informazioni

    Questo sito utilizza i cookie per fornire la migliore esperienza di navigazione possibile. Continuando a utilizzare questo sito senza modificare le impostazioni dei cookie o cliccando su "Accetta" permetti il loro utilizzo.

    Chiudi