Làm sao để sắp xếp nhiều cột và hàng theo abc vậy ạ ? (2 người xem)

[gfhngjn]

đề bài

làm sao để cho kết quả như vậy ạ ?

 

[kenytien]

giải thích rõ hơn được không

 

[gfhngjn]

giải thích rõ hơn được không

đã update

 

[Hoàng Tuấn 868]

đề bài
Kết quả
đã update

Ba câu chỏng gọng, chuyển ảnh từ ngang sang dọc. Không hiểu nổi.

 

[ptm0412]

đã update

Định trả lời nhưng đọc 2 bài 2 và 3 thấy mất hứng, ngó lại bài 1 thấy sau "update" lại còn dở hơn trước update vì chẳng còn câu thoại nào.

 

[gfhngjn]

dạ xin lỗi ạ, ảnh ngang bạn kia ko hiểu nên chỉnh như vậy

 

[ongke0711]

Cái bài này cũng thú vị nhỉ nhưng chưa biết làm . Đưa tất cả trị vào Dictionary để loại bỏ trùng rồi dùng bubble sort xong chưa biết làm sao so sánh để cách dòng.

 

[ongke0711]

Thử code này. Chỉ chạy đúng với dữ liệu như trên hình.

Option Explicit

Dim arrSort() As String

Sub NormalizeColumns()
    Dim ws As Worksheet, rng As Range
    Dim lastRow As Long, lastCol As Long
    Dim col As Long, r As Long
    Dim dict As Object
    Dim cellValue As String
    Dim arr(), arrSrc, arrResult(10, 5) As String, i As Long, j As Long, k As Long
   
    Set ws = ActiveSheet
    Set rng = ws.Range("A1:C5")
    arrSrc = rng
    lastRow = UBound(arrSrc, 1): lastCol = UBound(arrSrc, 2)
   
    Call TongHopVaSapXep
    For k = 1 To UBound(arrSrc, 2)
        For i = 0 To UBound(arrSort)
            'Debug.Print arrSort(i), arrSrc(i + 1, 1)
           
            For j = 1 To UBound(arrSrc, 1)
                Debug.Print "  --" & arrSrc(j, 1)
                If arrSort(i) = arrSrc(j, k) Then
                    arrResult(i, k - 1) = arrSrc(j, k)
                    Exit For
                Else
                    arrResult(i, k - 1) = "-"
                End If
            Next j
           
        Next i
    Next k
   
    Worksheets("Sheet1").Range("A8").Resize(UBound(arrResult, 1) + 1, UBound(arrResult, 2) + 1).Value = arrResult
   
End Sub

Sub TongHopVaSapXep()
    Dim rng As Range, cell As Range, temp As String
    Dim dict As Object
    Dim i As Long, j As Long, outputCol As Long

    Set rng = Sheet1.Range("A1:C5")
    Set dict = CreateObject("Scripting.Dictionary")
   
    ' Loc và thêm giá tri không trùng
    For Each cell In rng
        If Trim(cell.Value) <> "" Then
            If Not dict.exists(cell.Value) Then
                dict.Add cell.Value, 1
            End If
        End If
    Next cell
    'Chuyen thanh mang de so sanh
    ReDim arrSort(0 To dict.Count - 1)
    For i = 0 To dict.Count - 1
        arrSort(i) = dict.Keys()(i)
    Next i

    ' Bubble sort
    For i = 0 To UBound(arrSort) - 1
        For j = i + 1 To UBound(arrSort)
            If arrSort(i) > arrSort(j) Then
                temp = arrSort(i)
                arrSort(i) = arrSort(j)
                arrSort(j) = temp
            End If
        Next j
    Next i
End Sub

 

[ngoctinh87]

Bài này nếu dùng E365 chắc xử lý được

 

[Duy Tùng 9x]

đề bài
View attachment 308115
làm sao để cho kết quả như vậy ạ ?
View attachment 308116

Chắc mong muốn của bạn là như này