Riordinare dati sparsi in un unico rigo

Question

Signori

Mi trovo con questa tabella composta di numeri buttati li a caso ed ogniuno di loro ha un colore diverso , volendo usare un pulsante con VBA esisterebbe un modo di ottenerli tutti in ordine in A1:L1 ?

Al giro seguente ne verranno incollati altri completamente diversi e cliccando sul pulsante si ottiene la stessa cosa e cosi via .

Di seguito la Link di un file di prova : https://1drv.ms/x/c/a730b65538eaaf7e/EXBiRx89UkBDsrvcPF4rBi4BVovulBDphxe0HN8j\_asprA?e=l6fWan

Grazie.

Answer 1

Io la vedrei così:

Dim intV As Integer, rngC As Range

    With Worksheets("Foglio1")

         .Range("A1:L1").Clear

        intV = 1

        For Each rngC In .Range("A2:Z1000")

            If rngC.Value <> "" Then

               rngC.Copy .Cells(1, intV)

               intV = intV + 1

            End If

        Next rngC

        With .Sort

            .SetRange Range("A1:L1")

            .Header = xlGuess

            .MatchCase = False

            .Orientation = xlLeftToRight

            .SortMethod = xlPinYin

            .Apply

        End With

    End With

End Sub

Ciao.

Answer 2

La risposta è stata tradotta automaticamente. Di conseguenza, potrebbero esserci errori grammaticali o parole insolite.

Ciao, Volpino-Office365

Grazie per aver utilizzato i prodotti Microsoft e per averli pubblicati nella community.

Prova questo:

Sub ArrangeNumbersWithColors() 

    Dim ws As Worksheet 

    Dim rng As Range 

    Dim cell As Range 

    Dim targetRow As Integer 

    Dim targetColumn As Integer 

    Dim i As Integer 

    Set ws = ThisWorkbook.Sheets(1)  ' Modificare l'indice del foglio di lavoro come necessario 

    ws.Range("A1:L1").ClearContents 

    ws.Range("A1:L1").Interior.ColorIndex = xlNone 

    ws.Range("A1:L1").Font.ColorIndex = xlAutomatic 

    targetRow = 1 

    targetColumn = 1 

    For i = 1 To 12 

        For Each cell In ws.UsedRange 

            If IsNumeric(cell.Value) Then 

                If cell.Value = i Then 

                    With ws.Cells(targetRow, targetColumn) 

                        .Value = i 

                        .Interior.Color = cell.Interior.Color 

                        .Font.Color = cell.Font.Color 

                        '.Font.Bold = cell.Font.Bold 

                        '.Font.Size = cell.Font.Size 

                    End With 

                    targetColumn = targetColumn + 1 

                    Exit For 

                End If 

            End If 

        Next cell 

    Next i 

    MsgBox "okkkk", vbInformation 

End Sub 

Spero che le informazioni di cui sopra possano aiutarti. Sentiti libero di inviare un messaggio se hai bisogno di ulteriore aiuto.

I miei migliori auguri

Aiden.C - MSFT |Specialista del supporto della community Microsoft

Answer 3

Ho provato la formula , forse ci é stato un malinteso , i dati arrivano in A1:L1 ma non arrivano in ordine progressivo , intendo dal numero 1 in A1 fino al numero 12 in L1 , mentre la formula proposta nella risposta precedente funziona correttamente.

A me si, vengono scritti come li trova, poi c'è la parte di codice che li ordina in orizzontale:

che poi sarebbe, banalmente, la riproposizione di ciò che si può fare manualmente:

ma l'importante è che hai risolto,

ciao.

Answer 4

Io la vedrei così:

Dim intV As Integer, rngC As Range



    With Worksheets("Foglio1")



         .Range("A1:L1").Clear



        intV = 1



        For Each rngC In .Range("A2:Z1000")



            If rngC.Value <> "" Then



               rngC.Copy .Cells(1, intV)



               intV = intV + 1



            End If



        Next rngC



        With .Sort



            .SetRange Range("A1:L1")



            .Header = xlGuess



            .MatchCase = False



            .Orientation = xlLeftToRight



            .SortMethod = xlPinYin



            .Apply



        End With



    End With



    



End Sub

Ciao.

Ciao

Ho provato la formula , forse ci é stato un malinteso , i dati arrivano in A1:L1 ma non arrivano in ordine progressivo , intendo dal numero 1 in A1 fino al numero 12 in L1 , mentre la formula proposta nella risposta precedente funziona correttamente.

Answer 5

La risposta è stata tradotta automaticamente. Di conseguenza, potrebbero esserci errori grammaticali o parole insolite.

Ciao, Volpino-Office365

Per quanto riguarda i pulsanti, è possibile andare su Strumenti sviluppatore - Inserisci - Pulsanti.

È sufficiente specificare la macro quando la si seleziona.

Spero che le informazioni di cui sopra possano aiutarti. Sentiti libero di inviare un messaggio se hai bisogno di ulteriore aiuto.

I miei migliori auguri

Aiden.C - MSFT |Specialista del supporto della community Microsoft