Hàm tự tạo ToTable - Chuyển dữ liệu thành dạng bảng. (1 người xem)

[huuthang_bd]

Tôi thấy thỉnh thoảng có một số bạn có nhu cầu chuyển dữ liệu từ dạng Cột (Hàng) sang dạng bảng và ngược lại. Những yêu cầu như thế có thể dùng công thức để làm được tuy nhiên cũng rất phức tạp và có lẽ nhiều người không tự mình làm được. Hơn nữa, khi dữ liệu nguồn là nhiều vùng khác nhau thì việc thực hiện bằng công thức dường như bất khả thi.

Vì vậy, tôi tạo hàm ToTable này, với độ tùy biến cao và dễ sử dụng hi vọng sẽ giúp ích cho một số bạn có nhu cầu này.

Hàm được sử dụng với dạng công thức mảng có cú pháp như sau:
=ToTable([Vùng dữ liệu nguồn],[Cách lấy dữ liệu nguồn],[Cách xếp kết quả])

[Vùng dữ liệu nguồn]: Là vùng chứa dữ liệu nguồn cần chuyển đổi, nếu là nhiều vùng thì tất cả cho vào trong cặp ngoặc đơn ()
[Cách lấy dữ liệu nguồn]: Lấy dữ liệu từ trên xuống dưới, từ trái qua phải hay ngược lại.
- 0 (False): Lấy dữ liệu từ trên xuống dưới, từ trái qua phải (mặc định)
- 1 (True): Lấy dữ liệu từ trên xuống dưới, từ trái qua phải
[Cách xếp kết quả]: Xếp kết quả từ trên xuống dưới, từ trái qua phải hay ngược lại.
- 0 (False): Xếp kết quả từ trên xuống dưới, từ trái qua phải (mặc định)
- 1 (True): Xếp kết quả từ trên xuống dưới, từ trái qua phải

Function ToTable(ByVal Rng As Range, Optional ByVal SourceR As Boolean = False, Optional ByVal ResultR As Boolean = False)
'''''''''''''''''''''''''''''''
'Nguyen Huu Thang             '
'http://www.giaiphapexcel.com '
'''''''''''''''''''''''''''''''
On Error Resume Next
Dim iArea As Range, i As Long, j As Long, Tmp, RCount As Long, iR As Long, iC As Long
Set iArea = Application.Caller
On Error GoTo 0
If iArea Is Nothing Then Exit Function
RCount = iArea.Count
If RCount = 1 Then
    ToTable = Rng.Areas(1).Cells(1, 1).Value
    Exit Function
Else
    ReDim Tmp(1 To iArea.Rows.Count, 1 To iArea.Columns.Count)
    If Not ResultR Then
        iR = UBound(Tmp, 1)
        If Not SourceR Then
            For Each iArea In Rng.Areas
                For j = 1 To iArea.Columns.Count
                    For i = 1 To iArea.Rows.Count
                        If iR = UBound(Tmp, 1) Then
                            iC = iC + 1
                            iR = 1
                        Else
                            iR = iR + 1
                        End If
                        Tmp(iR, iC) = iArea.Cells(i, j).Value
                        If iR * iC = RCount Then GoTo Done
                    Next
                Next
            Next
        Else
            For Each iArea In Rng.Areas
                For i = 1 To iArea.Rows.Count
                    For j = 1 To iArea.Columns.Count
                        If iR = UBound(Tmp, 1) Then
                            iC = iC + 1
                            iR = 1
                        Else
                            iR = iR + 1
                        End If
                        Tmp(iR, iC) = iArea.Cells(i, j).Value
                        If iR * iC = RCount Then GoTo Done
                    Next
                Next
            Next
        End If
        For i = iR + 1 To UBound(Tmp, 1)
            Tmp(i, iC) = "#N/A"
        Next
        iC = iC + 1
        For j = iC To UBound(Tmp, 2)
            For i = 1 To UBound(Tmp, 1)
                Tmp(i, j) = "#N/A"
            Next
        Next
    Else
        iC = UBound(Tmp, 2)
        If Not SourceR Then
            For Each iArea In Rng.Areas
                For j = 1 To iArea.Columns.Count
                    For i = 1 To iArea.Rows.Count
                        If iC = UBound(Tmp, 2) Then
                            iC = 1
                            iR = iR + 1
                        Else
                            iC = iC + 1
                        End If
                        Tmp(iR, iC) = iArea.Cells(i, j).Value
                        If iR * iC = RCount Then GoTo Done
                    Next
                Next
            Next
        Else
            For Each iArea In Rng.Areas
                For i = 1 To iArea.Rows.Count
                    For j = 1 To iArea.Columns.Count
                        If iC = UBound(Tmp, 2) Then
                            iC = 1
                            iR = iR + 1
                        Else
                            iC = iC + 1
                        End If
                        Tmp(iR, iC) = iArea.Cells(i, j).Value
                        If iR * iC = RCount Then GoTo Done
                    Next
                Next
            Next
        End If
        For j = iC + 1 To UBound(Tmp, 2)
            Tmp(iR, j) = "#N/A"
        Next
        iR = iR + 1
        For i = iR To UBound(Tmp, 1)
            For j = 1 To UBound(Tmp, 2)
                Tmp(i, j) = "#N/A"
            Next
        Next
    End If
Done:
ToTable = Tmp
End If
End Function

 

[hntvnn]

mình muốn hỏi bạn 1 chút, mình không sao chỉnh được vùng nhận dạng rộng thêm (có phải tinh chỉnh trong code không, mình không tìm thấy code ở trong vba) mong bạn trả lời giúp.

 

[huuthang_bd]

mình muốn hỏi bạn 1 chút, mình không sao chỉnh được vùng nhận dạng rộng thêm (có phải tinh chỉnh trong code không, mình không tìm thấy code ở trong vba) mong bạn trả lời giúp.

1. Đây là hàm mảng nên phải sử dụng như công thức mảng. Khi 1 vùng có 1 công thức mảng thì bạn không thể thay đổi 1 phần của mảng đó, muốn sửa hay xóa thì phải thực hiện trên cả mảng đó (Tất cả các công thức mảng đều phải như vậy). Vì vậy, bạn phải xác định vùng kết quả trước khi nhập công thức.
2. Code trong Module1 trong file và cũng là code tôi post lên.