Sortare Mixta Numere-Text

Tuca
Mesaje: 6
Membru din: Mie Noi 23, 2011 2:50 pm

Sortare Mixta Numere-Text

Mesaj de Tuca » Mar Mar 05, 2019 11:55 am

Salutare !
Sunt un novice în VBA. Mă poate „rezolva” cineva ?
Mulțumesc anticipat !
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.

IPP
Moderator
Moderator
Mesaje: 4196
Membru din: Mie Iul 29, 2009 7:26 am
Localitate: Cluj-Napoca

Re: Sortare Mixta Numere-Text

Mesaj de IPP » Mar Mar 05, 2019 2:25 pm

Buna ziua

In primul rand trebuie sa renuntati la celule contopite (merge cells)

Apoi, nu stiu in ce masura merita efortul de a crea macro. Practic va puteti folosi de instrumentele native excel:
Pas1: selectare tot domeniul de celule, sortare ascendenta, duce la o aranjare a informatiei incepand cu numere apoi text
Pas2: selectare doar domeniu de celule ce au legatura cu numerele si sortare descendenta
Pas3: selectare doar domeniu de celule ce au legatura cu informatia text si sortare ascendenta.

Nu stiu daca are rost dar mai trebuie retinut ca selectia nu inseamna doar zona in care exista valorile pe care le dorim ca si criteriu

IP

Tuca
Mesaje: 6
Membru din: Mie Noi 23, 2011 2:50 pm

Re: Sortare Mixta Numere-Text

Mesaj de Tuca » Mie Mar 06, 2019 11:10 am

Mulțumesc pentru atenția acordată !
Ideea este că cei care ar urma să uzeze de buton nu știu nici cât mine să facă filtrări și sortări.
Am mai primit de la un binevoitor o soluție aproape completă: a folosit: UnMerge și Merge.
Numai bine !

TudyBTH
Moderator
Moderator
Mesaje: 993
Membru din: Joi Feb 11, 2016 2:12 pm
Localitate: Cluj Napoca

Re: Sortare Mixta Numere-Text

Mesaj de TudyBTH » Mie Mar 06, 2019 2:55 pm

Buna,

aveti mai jos un cod

Cod: Selectaţi tot

Sub CustomSort()

'------------------------------------------
'   modificati aici conform fisierului real
Const numeFoaie As String = "Sort"
Const adresaSursaSortare As String = "B3:E37"
Const adresaDestinatieSortare As String = "L3:O37"
'------------------------------------------

    Dim arr() As Variant
    Dim r As Range
    Dim i As Integer, j As Integer, k As Integer
    Dim tmp As Variant
    
    
    Application.ScreenUpdating = False
    Set r = ThisWorkbook.Sheets(numeFoaie).Range(adresaSursaSortare)
    arr = r.Value
    
    For i = 1 To UBound(arr, 1) - 1
        If Not IsEmpty(arr(i, 2)) Then
            For j = i To UBound(arr, 1)
                If Not IsEmpty(arr(j, 2)) Then
                    If (Not IsNumeric(arr(i, 2))) And IsNumeric(arr(j, 2)) Then
                        For k = 1 To UBound(arr, 2)
                            tmp = arr(i, k): arr(i, k) = arr(j, k): arr(j, k) = tmp
                        Next k
                    End If
                End If
            Next j
        End If
    Next i
    
    For i = 1 To UBound(arr, 1) - 1
        If Not IsEmpty(arr(i, 2)) Then
            For j = i To UBound(arr, 1)
                If Not IsEmpty(arr(j, 2)) Then
                    If IsNumeric(arr(i, 2)) And IsNumeric(arr(j, 2)) And arr(i, 2) < arr(j, 2) Then
                        For k = 1 To UBound(arr, 2)
                            tmp = arr(i, k): arr(i, k) = arr(j, k): arr(j, k) = tmp
                        Next k
                    End If
                    If (Not IsNumeric(arr(i, 2))) And (Not IsNumeric(arr(j, 2))) And arr(i, 2) > arr(j, 2) Then
                        For k = 1 To UBound(arr, 2)
                            tmp = arr(i, k): arr(i, k) = arr(j, k): arr(j, k) = tmp
                        Next k
                    End If
                End If
            Next j
        End If
    Next i
    
    Set r = ThisWorkbook.Sheets(numeFoaie).Range(adresaDestinatieSortare)
    r.Value = arr
    Application.ScreenUpdating = True
    
End Sub
puteti modifica numele foii si adresle sursa/destinatie la inceputul procedurii conform fisierului in care implementati codul.
Evident, daca cele doua adrese se refera la zone diferite ele trebuie sa aibe aceasi dimensiune si aceaasi structura. Daca doriti ca filtrarea sa se faca in acelasi loc, treceti aceasi adresa si la destinatie.
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
Am invatat sa inotam in apa, ca pestii
Am invatat sa zburam in aer, ca pasarile
A ramas doar sa invatam sa traim pe Pamant, ca Oamenii.

Tuca
Mesaje: 6
Membru din: Mie Noi 23, 2011 2:50 pm

Re: Sortare Mixta Numere-Text

Mesaj de Tuca » Joi Mar 07, 2019 5:29 pm

Mulțumesc mult !
Rulează perfect.
Era mult prea „dificil” pentru mine !

Scrie răspuns

Înapoi la “Visual Basic for Application (VBA) cu Excel - Intrebari tehnice”