Chuyển dữ liệu 2 chiều thành 1 chiều có loại bỏ ô trống

[ptm0412]

Đôi khi ta muốn chuyển dữ liệu từ bảng 2 chiều thành 1 cột duy nhất. Có thể dùng công thức để làm chuyện này:
Giả sử ta có dữ liệu như sau (5 dòng 4 cột):

|

A​

|

B​

|

C​

|

D​

|

1​

|

a1​

|

a2​

|

a3​

|

a4​

|

2​

|b1|b2|b3|b4|

3​

|c1|c2|c3|c4|

4​

|d1|d2|d3|d4|

5​

|e1|e2|e3|e4|

Tại 1 ô bất kỳ ta dùng công thức:

=INDEX($A$1:$D$5;INT((ROW(1:1)-1)/4)+1;MOD(ROW(1:1)-1;4)+1)

và fill xuống đến khi nào đủ thì ngưng. Trong đó số 4 là số cột.

Tuy nhiên, nếu dữ liệu có ô trống như sau:

|

A​

|

B​

|

C​

|

D​

|

1​

|

a1​

|

a2​

|

a3​

||

2​

|b1|b2| |b4|

3​

| |c2|c3| |

4​

|d1|d2| |d4|

5​

| |e2|e3| |

Thì kết quả sẽ có những ô có giá trị 0. Và đó là điều ta không muốn.

Ta có thể dùng VBA với 1 chút thủ thuật như sau:
- Dựa vào tính chất của hàm Index (của Excel): Nếu để trống tham số dòng sẽ lấy nguyên cột, nếu để trống tham số cột lấy nguyên dòng.
- Sử dụng hàm Filter của VBA loại bỏ ô trống.

1. Nếu muốn sắp theo thứ tự từng dòng:

Sub test1()
Dim i As Long, SourceArr, tmp, ResultArr
On Error GoTo Goback
[j1:j20].ClearContents
With Range("A1:D5")
  .SpecialCells(4).Value = "~"
  SourceArr = .Value

  For i = 1 To UBound(SourceArr, 1)
    tmp = tmp & "|" & Join(Application.Index(SourceArr, i), "|")
  Next
  ResultArr = Filter(Split(Mid(tmp, 2), "|"), "~", False)
  Cells(1, 10).Resize(UBound(ResultArr) + 1) = Application.Transpose(ResultArr)
Goback:
.Replace what:="~~", replacement:=""
End With
End Sub

2. Nếu muốn sắp theo thứ tự từng cột:

Sub test2()
Dim i As Long, SourceArr, tmp, ResultArr
On Error GoTo Goback
[j1:j20].ClearContents
With Range("A1:D5")
  .SpecialCells(4).Value = "~"
  SourceArr = .Value

  For i = 1 To UBound(SourceArr, 2)
    tmp = tmp & "|" & Join(Application.Transpose(Application.Index(SourceArr, , i)), "|")
  Next
  ResultArr = Filter(Split(Mid(tmp, 2), "|"), "~", False)
  Cells(1, 10).Resize(UBound(ResultArr) + 1) = Application.Transpose(ResultArr)
Goback:
.Replace what:="~~", replacement:=""
End With
End Sub

Kết quả:

Test1|Test2|
a1|a1|
a2|b1|
a3|d1|
b1|a2|
b2|b2|
b4|c2|
c2|d2|
c3|e2|
d1|a3|
d2|c3|
d4|e3|
e2|b4|
e3|d4|

Với dữ liệu nhiều dòng, dùng Dict có thể nhanh hơn, nhưng tôi muốn giới thiệu 1 thuật toán khác lạ nhưng đơn giản (sưu tầm & chế biến) chạy bằng mảng Array thông thường.

 

[ndu96081631]

Chuyển dữ liệu 2 chiều thành 1 chiều có loại bỏ ô trống.

Sư phụ "thất nghiệp" nên moi đồ chơi ra "vọc" đây
Ẹc... Ẹc... Tội nghiệp sư phụ quá... (sao hổng ai hỏi câu nào hay hay về PivotTable hay Chart cho sư phụ đở.. rảnh nhỉ?)

 

[thanhlanh]

Sư phụ cho hỏi sao khi gõ (hoặc gán) một dấu ngã mà đến lúc tìm phải tìm hai dấu ngã?

 

[ptm0412]

Nói thêm về việc sử dụng Dic trong topic này:
Duyệt qua mảng Source Array, dòng trước cột sau hoặc ngược lại theo ý muốn, nếu <>"" thì add 1 item và 1 key vào Dic. Sau đó gán Dic xuống sheet. Nhanh cực kỳ.

Sub test3()
Dim Dic1, i As Long, j As Long, s As Long, SourceArr
t = Timer
Set Dic1 = CreateObject("Scripting.Dictionary")
SourceArr = Range("A1:D100").Value
For i = 1 To 100
    For j = 1 To 4
        If SourceArr(i, j) <> "" Then
            s = s + 1
            Dic1.Add s, SourceArr(i, j)
        End If
    Next
Next
Cells(2, 11).Resize(s) = Application.Transpose(Dic1.items)
Cells(1, 11) = Timer - t
End Sub

Cũng code này, chỉ cần đổi lên đổi xuống 2 dòng for là sắp xếp được kết quả theo cách khác:
Thay:

For i = 1 To 100
    For j = 1 To 4

Bằng:

For j = 1 To 4
    For i = 1 To 100

Xem file đính kèm và so sánh tốc độ 4 code.

 

[ptm0412]

Sư phụ cho hỏi sao khi gõ (hoặc gán) một dấu ngã mà đến lúc tìm phải tìm hai dấu ngã?

Với 1 số ký tự đặc biệt, khi tìm kiếm phải gõ 1 dấu ~ phía trước để tìm.
Thí dụ các ký tự * và ?. Hai ký tự này bình thường * đại diện cho chuỗi nhiều ký tự còn ? đại diện cho 1 ký tự trong tìm kiếm.
Khi tìm kiếm bản thân dấu * hoặc ? thì phải thêm dấu ~: ~*, ~?
Khi tìm bản thân dấu ~, thì phải là ~~.

http://www.giaiphapexcel.com/forum/...ý-tự-đặc-biệt-trong-excel&p=278193#post278193

 

[ndu96081631]

Xem file đính kèm và so sánh tốc độ 4 code.

Em thấy không dùng Dictionary cũng được mà sư phụ:

Sub Test5()
  Dim Arr(), i As Long, j As Long, s As Long, SourceArr, t As Double
  t = Timer
  SourceArr = Range("A1:D100").Value
  ReDim Arr(1 To 400, 1 To 1)
  For j = 1 To 4
    For i = 1 To 100
      If SourceArr(i, j) <> "" Then
        s = s + 1
        Arr(s, 1) = SourceArr(i, j)
      End If
    Next
  Next
  Cells(2, 13).Resize(s) = Arr
  Cells(1, 13) = Format(Timer - t, "0.000000")
End Sub

Khỏi TRANSPOSE luôn và tốc độ gần như tương đương.
Cho dữ liệu lên đến khoảng 12000 dòng thì code em nhanh hơn à nha
Ẹc... Ẹc...

 

[thanhlanh]

Em thấy không dùng Dictionary cũng được mà sư phụ:

Sub Test5()
  Dim Arr(), i As Long, j As Long, s As Long, SourceArr, t As Double
  t = Timer
  SourceArr = Range("A1:D100").Value
  ReDim Arr(1 To 400, 1 To 1)
  For j = 1 To 4
    For i = 1 To 100
      If SourceArr(i, j) <> "" Then
        s = s + 1
        Arr(s, 1) = SourceArr(i, j)
      End If
    Next
  Next
  Cells(2, 13).Resize(s) = Arr
  Cells(1, 13) = Format(Timer - t, "0.000000")
End Sub

Khỏi TRANSPOSE luôn và tốc độ gần như tương đương.
Cho dữ liệu lên đến khoảng 12000 dòng thì code em nhanh hơn à nha
Ẹc... Ẹc...

Một bài toán được các sư phụ giải bằng 3 cách khác nhau mà cách nào cũng hay cả.
----------
Hỏi ngoài lề ndu chút: ndu chuển code ra module (tất nhiên chỉ để lại một sheet) là do thói quen hay có mục đích gì vậy?

 

[ndu96081631]

Hỏi ngoài lề ndu chút: ndu chuển code ra module (tất nhiên chỉ để lại một sheet) là do thói quen hay có mục đích gì vậy?

Vì em đang tính đến hướng sẽ chuyển Sub này thành 1 Function hoặc 1 sub có tham số truyền nên để trong Module là hợp lý nhất (chạy ở đâu cũng được)
Còn việc xóa hết chỉ chừa lại 1 sheet là do thói quen tiết kiệm của em, chỉ xài vừa đủ, không thừa không thiếu

 

[ptm0412]

Mình cũng dự định nếu dùng thường xuyên hoặc cần chuyển đổi dữ liệu trong 1 project lớn hơn, sẽ dùng tham số truyền. Vậy đưa vào Module là hợp lý.

Đại khái là Sub sẽ có 2 hoặc 3 tham số:
1 là vùng dữ liệu cần chuyển đổi,
2 là hướng chuyển đổi (dòng trước cột sau hoặc ngược lại)
3 là đích ghi kết quả

Nếu là Function thì không có tham số thứ 3.

 

[ndu96081631]

Mình cũng dự định nếu dùng thường xuyên hoặc cần chuyển đổi dữ liệu trong 1 project lớn hơn, sẽ dùng tham số truyền. Vậy đưa vào Module là hợp lý.

Đại khái là Sub sẽ có 2 hoặc 3 tham số:
1 là vùng dữ liệu cần chuyển đổi,
2 là hướng chuyển đổi (dòng trước cột sau hoặc ngược lại)
3 là đích ghi kết quả

Nếu là Function thì không có tham số thứ 3.

- Có vẻ như dùng Sub có tham số truyền thì khỏe hơn (vì Array kết quả ta không định được chính xác kích thước của nó)
- Có thể cải tiến thêm để code hoạt động được với nhiều vùng không liên tục

 

[bitmap007]

Em hoi cac bac ti nhe. Neu muon chuyen khoang 10 line thanh 1 cot roi 10 line tiep theo thanh cot thu 2... thi sao cac bac. Y em la tu 1->9 thanh 1 cot, tu 11->19 thanh cot 2....Tram su nho cac pac. Em chot merge line 10, 20,... cua em roi. Cam on cac pac.

 

[ndu96081631]

Em hoi cac bac ti nhe. Neu muon chuyen khoang 10 line thanh 1 cot roi 10 line tiep theo thanh cot thu 2... thi sao cac bac. Y em la tu 1->9 thanh 1 cot, tu 11->19 thanh cot 2....Tram su nho cac pac. Em chot merge line 10, 20,... cua em roi. Cam on cac pac.

Mô tả bao nhiêu câu cũng chẳng có ý nghĩa gì nếu bạn không cho file lên đây (ai biết cụ thể thế nào mà giúp bạn đây)

 

[bitmap007]

Sorry pac, em lay luon VD nhe.

 

[ptm0412]

chuyen khoang 10 line thanh 1 cot roi 10 line tiep theo thanh cot thu 2... thi sao cac bac. Y em la tu 1->9 thanh 1 cot, tu 11->19 thanh cot 2....

Mới đọc thì tưởng là chuyển từ 1 chiều thành 2 chiều, số dòng định trước là 9, bỏ qua dòng chẵn chục.

Té ra là chuyển lần lượt từng cụm 2 chiều thành từng cột 1 chiều kế tiếp nhau.

 

[bitmap007]

Mới đọc thì tưởng là chuyển từ 1 chiều thành 2 chiều, số dòng định trước là 9, bỏ qua dòng chẵn chục.

Té ra là chuyển lần lượt từng cụm 2 chiều thành từng cột 1 chiều kế tiếp nhau.

Vang chinh xac la nhu vay do bac. Cac bac xem chinh sua lai code dum em nhe. Cam on bac nhieu.