Chuyển từ mảng 2 chiều qua mảng 1 chiều (1 người xem)

[thunoka]

Chào các bạn,

Mình mới làm wen với VBA nên không biết làm sao để chuyển từ mảng 2 chiều sang mảng 1 chiều. Các bạn có thể coi hình này:

Cho mình hỏi là phải code như thế nào để có mảng như trên?

Mong các bạn giúp mình với! Cảm ơn các bạn nhiều lắm!

 

[ndu96081631]

Chào các bạn,

Mình mới làm wen với VBA nên không biết làm sao để chuyển từ mảng 2 chiều sang mảng 1 chiều. Các bạn có thể coi hình này:

Cho mình hỏi là phải code như thế nào để có mảng như trên?

Mong các bạn giúp mình với! Cảm ơn các bạn nhiều lắm!

Tạm làm như vầy đi cho dể hiểu nhé:

Sub Test()
  Dim Rng As Range, Clls As Range
  Dim i As Long, j As Long, k As Long
  Set Rng = Range("B1:E3")
  For i = 1 To Rng.Columns.Count
    For j = 1 To Rng.Rows.Count
      Cells(6, k + 2) = Rng(j, i): k = k + 1
    Next
  Next
End Sub

 

[Mr Okebab]

Chào các bạn,

Mình mới làm wen với VBA nên không biết làm sao để chuyển từ mảng 2 chiều sang mảng 1 chiều. Các bạn có thể coi hình này:

Cho mình hỏi là phải code như thế nào để có mảng như trên?

Mong các bạn giúp mình với! Cảm ơn các bạn nhiều lắm!

Chuyển thế này thì rất dễ, tuy nhiên không biết bài toán cụ thể của bạn là như thế nào vì có thể dùng Sub hoặc Function đều được hết.

Thân!

 

[cadafi]

Chào các bạn,

Mình mới làm wen với VBA nên không biết làm sao để chuyển từ mảng 2 chiều sang mảng 1 chiều. Các bạn có thể coi hình này:

Cho mình hỏi là phải code như thế nào để có mảng như trên?

Mong các bạn giúp mình với! Cảm ơn các bạn nhiều lắm!

Chào bạn,
Bạn xem đoạn code này:

Sub HaiChieuToMotChieu()
RngHaiChieu = Application.InputBox("Nhap Mang hai chieu vao day", "Thong bao", Type:=8)
Zi = 0
For Each Cll In RngHaiChieu
Sheets("Sheet1").[B8].Offset(, Zi).Value = Cll
Zi = Zi + 1
Next Cll
End Sub

Và xem thêm file đính kèm nhé!

 

[ndu96081631]

Chào bạn,
Bạn xem đoạn code này:

Sub HaiChieuToMotChieu()
RngHaiChieu = Application.InputBox("Nhap Mang hai chieu vao day", "Thong bao", Type:=8)
Zi = 0
For Each Cll In RngHaiChieu
Sheets("Sheet1").[B8].Offset(, Zi).Value = Cll
Zi = Zi + 1
Next Cll
End Sub

Và xem thêm file đính kèm nhé!

Nhân có đoạn code của ca_dafi tôi phát hiện 1 chuyện hơi lạ:
Nếu:

RngHaiChieu = Application.InputBox("Nhap Mang hai chieu vao day", "Thong bao",Type:=8)

thì không có vấn đề gì
nhưng nếu:

Set RngHaiChieu = Application.InputBox("Nhap Mang hai chieu vao day", "Thong bao",Type:=8)

Thì kết quả trả về không đúng với yêu cầu.. Cụ thể trong trường hợp dưới nó duyệt range từ trái sang phải, xong mới từ trên xuống... Còn cách làm của ca_dafi thì nó duyệt từ trên xuống, xong mới từ trái sang phải
Sao thế nhỉ?

 

[cadafi]

Nhân có đoạn code của ca_dafi tôi phát hiện 1 chuyện hơi lạ:
Nếu:
thì không có vấn đề gì
nhưng nếu:
Thì kết quả trả về không đúng với yêu cầu.. Cụ thể trong trường hợp dưới nó duyệt range từ trái sang phải, xong mới từ trên xuống... Còn cách làm của ca_dafi thì nó duyệt từ trên xuống, xong mới từ trái sang phải
Sao thế nhỉ?

Ta có thể từ từ nghiệm ra vấn đề bằng cách thêm một Msgbox sau đây:

Sub HaiChieuToMotChieu()
''Set RngHaiChieu = Application.InputBox("Nhap Mang hai chieu vao day", "Thong bao", Type:=8)

RngHaiChieu = Application.InputBox("Nhap Mang hai chieu vao day", "Thong bao", Type:=8)
MsgBox RngHaiChieu.Address  ''<=== Thêm dòng này!
Zi = 0
For Each Cll In RngHaiChieu
Sheets("Sheet1").[B8].Offset(, Zi).Value = Cll
Zi = Zi + 1
Next Cll
End Sub

 

[ptm0412]

Thêm 1 cách dùng công thức, nhưng hơi nhiêu khê:
- chuyển thành mảng dọc 1 chiều
- chuyển 1 lần nữa thành mảng ngang

Mới là ý tưởng, có thể bỏ bớt cột phụ, ô phụ
Cũng có thể sửa lại để chuyển trực tiếp thành mảng ngang theo ý tưởng đó.
Về lý thuyết có thể tăng kích thước mảng 2D tới giới hạn mà kết quả mảng ngang = 256 phần tử. (đã đặt name động cho mảng, nên tăng thử thoải mái)

TB: Thử xem khả năng tới đâu, chứ yêu cầu là VBA rõ rồi.

 

[ptm0412]

Hết nhiêu khê rồi, tất cả vào name.
Ghi chú cho file kèm theo: 3 dòng đầu chỉ để minh hoạ, có thể xoá.

 

[thunoka]

Cảm ơn các bạn nhiều nha! Mình muốn hỏi thêm 1 cái nữa, đó là nếu có nhiều mảng 2 chiều, muốn chuyển thành nhiều mảng 1 chiều như hình dưới thì làm thế nào?

Mình muốn là kết quả sẽ hiển thị ở sheet khác. Cảm ơn các bạn nhiều nhiều!

 

[cadafi]

Mình muốn là kết quả sẽ hiển thị ở sheet khác. Cảm ơn các bạn nhiều nhiều!

Bạn có thể thêm một dòng để yêu cầu chọn vị trí cần xuất ra mảng một chiều là xong.

Sub HaiChieuToMotChieu()
RngHaiChieu = Application.InputBox("Nhap Mang hai chieu vao day", "Thong bao", Type:=8)
Set RngMotChieu = Application.InputBox("Nhap O can xuat ra Mang Mot Chieu vao day", "Thong bao", Type:=8)
Zi = 0
For Each Cll In RngHaiChieu
RngMotChieu.Offset(, Zi).Value = Cll
Zi = Zi + 1
Next Cll
End Sub

Cảm ơn các bạn nhiều nha! Mình muốn hỏi thêm 1 cái nữa, đó là nếu có nhiều mảng 2 chiều, muốn chuyển thành nhiều mảng 1 chiều như hình dưới thì làm thế nào?

Bạn có thể chạy nhiều lần đoạn code này tương ứng với nhiều mảng hai chiều khác nhau!

 

[rollover79]

Xin góp 1 cách bằng công thức, càng kéo càng dài, kéo đê
Đây là cách làm theo thuật toán chung của việc chuyển mảng từ 2D sang 1D. Dùng code VBA cũng có thể dùng theo công thức này cũng ra được.

 

[ndu96081631]

Bài toán này có rất nhiều cách giãi: công thức và VBA
A> Bằng công thức:
Rất đơn giãn chỉ với 1 name duy nhất:

1> Đặt name cho vùng dử liệu:

Rng =Sheet1!$B$1:$E$3

2> Cuối cùng là công thức:

=INDEX(Rng,MOD((COLUMNS($A:A)-1),ROWS(Rng))+1,INT((COLUMNS($A:A)-1)/ROWS(Rng))+1)

Kéo fill công thức này sang phải, đến khi báo lổi thì dừng lại
Ghi chú: Công thức có thể đặt bất kỳ cell nào vẩn cho kết quả đúng
Công thức như của Rollover79 là chưa tổng quát đâu nhé (chú ý đến việc dùng ROW và COLUMN như có lần tôi đã nói... Lý ra phải là ROWS và COLUMNS )
​

B> Bằng VBA:
Nếu dùng vòng lập quét toàn bộ dử liệu thì dù 1 vòng lập hay 2 vòng lập, tốc độ vẩn như nhau (số lần quét đúng bằng tổng số cell hiện có của dử liệu)
Vậy để tăng tốc vòng lập ta dùng TRANSPOSE nhé

Sub Test()
 Dim Rng As Range, TempRng As Range
 Set Rng = Application.InputBox("Nhap Mang hai chieu vao day", "Thong bao", Type:=8)
 For i = 1 To Rng.Columns.Count
   Set TempRng = Rng.Offset(, i - 1).Resize(, 1)
   Set Des = Range("B8").Offset(, (i - 1) * TempRng.Count).Resize(, TempRng.Count)
   Des.Value = WorksheetFunction.Transpose(TempRng)
 Next
End Sub

Với cách này, tốc độ tăng lên rất nhiều lần (dử liệu càng lớn sẽ càng thấy có sự phân biệt)

 

[rollover79]

Công thức như của Rollover79 là chưa tổng quát đâu nhé (chú ý đến việc dùng ROW và COLUMN như có lần tôi đã nói... Lý ra phải là ROWS và COLUMNS )

Tôi chưa hiểu chỗ này lắm, xin được chỉ giáo thêm, chưa tổng quát theo tôi hiểu là sẽ có trường hợp sai. Làm ơn chỉ dùm tôi là trường hợp nào sai được không?
(Tôi chưa đọc cái bài viết về việc dùng ROW và COLUMN của bạn)
Cảm ơn!

 

[lypt]

Tạo UDF :

Function Mang1(ByVal Mang2 As Range) As Variant
Dim KQ(255)
h = Mang2.Rows.Count
C = Mang2.Columns.Count
For i = 0 To C * h - 1
    KQ(i) = Mang2((i Mod h) * C + Int(i / h) + 1)
Next i
Mang1 = KQ
End Function

Chọn vùng sẽ chứa mảng 1 chiều (một hàng nào đó bất kỳ, số lượng ô >= số lượng dữ liệu trong mảng 2 chiều), gõ công thức :
{=mang1(vùng dữ liệu mảng 2 chiều)} (dấu {} tương đương Ctrl-Shift-Enter)
Lấy ví dụ của thunoka :
Chọn vùng B9:M9, gõ {=mang1(B1:E3)}
Chọn vùng B10:M10, gõ {=mang1(B4:E6)}

 

[voda]

Nguyên văn bởi [B]ndu96081631[/B]
Sub Test()
 Dim Rng As Range, TempRng As Range
 Set Rng = Application.InputBox("Nhap Mang hai chieu vao day", "Thong bao", Type:=8)
 For i = 1 To Rng.Columns.Count
   Set TempRng = Rng.Offset(, i - 1).Resize(, 1)
   Set Des = Range("B8").Offset(, (i - 1) * TempRng.Count).Resize(, TempRng.Count)
   Des.Value = WorksheetFunction.Transpose(TempRng)
 Next
End Sub

Nếu chạy với nhiều mãng, code bị báo lỗi.

 

[ndu96081631]

Tôi chưa hiểu chỗ này lắm, xin được chỉ giáo thêm, chưa tổng quát theo tôi hiểu là sẽ có trường hợp sai. Làm ơn chỉ dùm tôi là trường hợp nào sai được không?

Dể lắm... bạn cứ copy công thức của bạn rồi đặt nó vào 1 cell khác... Cũng làm thế với công thức của tôi ---> So sánh kết quả ---> Suy ra vấn đề

(Tôi chưa đọc cái bài viết về việc dùng ROW và COLUMN của bạn)

Tôi không viết bài này nhưng đã có lần nhắc nhở (hình như là bạn hoangminhtien) về bài trích lọc danh sách duy nhất.. Trong file bạn ấy cũng đã từng dùng ROW và COLUMN (mà nếu tổng quát hơn thì phải là ROWS và COLUMNS mới đúng)
Mục đich là làm cho công thức đúng ở mọi vị trí đặt, chỉ vậy thôi
Nói thêm: File chúng ta đưa lên chỉ là "giã lập" (file tác giã đưa lên cũng thế).. Nhưng dử liệu thật rất có thể nằm ở vị trí khác (khác dòng, cột)... Đến chừng đó họ áp dụng vào bị sai thế nào cũng la làng
Ẹc... Ẹc

 

[ndu96081631]

Nguyên văn bởi [B]ndu96081631[/B]
Sub Test()
 Dim Rng As Range, TempRng As Range
 Set Rng = Application.InputBox("Nhap Mang hai chieu vao day", "Thong bao", Type:=8)
 For i = 1 To Rng.Columns.Count
   Set TempRng = Rng.Offset(, i - 1).Resize(, 1)
   Set Des = Range("B8").Offset(, (i - 1) * TempRng.Count).Resize(, TempRng.Count)
   Des.Value = WorksheetFunction.Transpose(TempRng)
 Next
End Sub

Nếu chạy với nhiều mãng, code bị báo lỗi.

Thầy ơi em chưa hiểu chổ này! Thầy giãi thích giúp em với

 

[voda]

Khi nhập vào Inputbox nhiều mãng 2 chiều (gọi theo chủ topic ) khác nhau, code trên bị báo lỗi. Để cho tổng quát hơn nữa, ndu xem lại chỗ này.

 

[ndu96081631]

Khi nhập vào Inputbox nhiều mãng 2 chiều (gọi theo chủ topic ) khác nhau, code trên bị báo lỗi. Để cho tổng quát hơn nữa, ndu xem lại chỗ này.

Có phải ý thầy muốn nói là chọn từ 2 vùng trở lên không liền nhau thì code sẽ báo lổi
Ví dụ: Vùng chọn là A1:B5,D5:F10,H9:K15
Nói chung thuật toán là dựa vào dử liệu thật mà hình thành... Nếu ý thầy đúng vậy thì em sẽ thêm 1 vòng lập nữa duyệt qua các Areas
(Em chưa rõ có hiểu đúng ý thầy không nên chưa đưa code lên)

 

[voda]

ndu đọc bài #9 sẽ thấy yêu cầu của bạn thunoka : muốn chuyển nhiều mãng 2 chiều thành nhiều mãng 1 chiều. Ý của mình đúng như bạn nói.