Bài viết: Hàm tự tạo ToTable - Chuyển dữ liệu thành dạng bảng

[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

Một số bài viết có liên quan:
1/ Xếp một trường theo một trật tự màu quy định trước
2/ Hàm để lấy chỉ số màu trong các ô đã Conditional Formatting
3/ Khai báo sử dụng các thành phần đối tượng của Excel
4/ Sử dụng Worksheet Function trong VBA
5/ Hiển thị tiếng việt cho hộp thông báo trong ACCESS & Excel
6/ Khai báo biến và đặt tên biến trong VBA
7/ Hướng dẫn truyền tham số trong VBA (ByVal & ByRef)
8/ UDF hữu ích: Xác định một vùng có tồn tại trong một vùng khác hay không
9/ UDF hữu ích: Một số hàm thông dụng cần thiết
10/ UDF hữu ích: Hàm tìm hàng cuối, cột cuối, ô cuối, ...

 

[minhtungph]

[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
[B][[B]Cách xếp kết quả[B]]: 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
[/B][/B][/B][/B][B][code][/B]