Chuyển từ mảng sang mảng bằng VBA trong excel

[leloimotminh1217]

gửi mọi người,

Hiện mình có 1 dữ liệu mảng lớn, cần phải xử lý sang 1 dạng mảng khác.
-sheet SOC chứa dữ liệu cần chuyển đổi, trong đó chỉ lấy dữ liệu ở 4 cột: [colore], [process1], [process8] và [wire ID].
-sheet BANG TICK DAY là dữ liệu cần sau khi chuyển đổi
Hình thức chuyển đổi ở sheet bang tick day:
-C3:N3 sẽ lấy dữ liệu từ R2:R13 của sheet SOC.
-C4:N4 sẽ lấy dữ liệu từ AV2:AV13 của sheer SOC
-C5:N5 sẽ lấy dữ liệu từ J2:J13 của sheet SOC.
-C6:N6 sẽ lấy dữ liệu từ Q2:Q13 của sheet SOC.
và tiếp tục như thế cho đến khi hết dữ liệu ở sheet SOC
Vì dữ liệu khá lớn(có thể lên đến 1000 dòng) nên muốn làm VBA cho nó pro nhưng mà thời gian có hạn nên không thể ngồi ngâm cứu hết được VBA.

nhờ các anh chị cao thủ giúp mình vụ này với.

 

[Quang_Hải]

gửi mọi người,

Hiện mình có 1 dữ liệu mảng lớn, cần phải xử lý sang 1 dạng mảng khác.
-sheet SOC chứa dữ liệu cần chuyển đổi, trong đó chỉ lấy dữ liệu ở 4 cột: [colore], [process1], [process8] và [wire ID].
-sheet BANG TICK DAY là dữ liệu cần sau khi chuyển đổi
Hình thức chuyển đổi ở sheet bang tick day:
-C3:N3 sẽ lấy dữ liệu từ R2:R13 của sheet SOC.
-C4:N4 sẽ lấy dữ liệu từ AV2:AV13 của sheer SOC
-C5:N5 sẽ lấy dữ liệu từ J2:J13 của sheet SOC.
-C6:N6 sẽ lấy dữ liệu từ Q2:Q13 của sheet SOC.
và tiếp tục như thế cho đến khi hết dữ liệu ở sheet SOC
Vì dữ liệu khá lớn(có thể lên đến 1000 dòng) nên muốn làm VBA cho nó pro nhưng mà thời gian có hạn nên không thể ngồi ngâm cứu hết được VBA.

nhờ các anh chị cao thủ giúp mình vụ này với.

Code cho bài này cũng không khó lắm nhưng có điều bị đảo dòng tại sheet kêt quả

Sub chuyen()
Dim dl(), i, j, kq(1 To 10000, 1 To 13), k
With Sheets("SOC")
   dl = .Range(.[J1], .[AV65536].End(3)).Value
End With
For i = 2 To UBound(dl) Step 12
   If dl(i, 1) <> "" Then
      kq(k + 1, 1) = dl(1, 1)
      kq(k + 2, 1) = dl(1, 8)
      kq(k + 3, 1) = dl(1, 9)
      kq(k + 4, 1) = dl(1, 39)
      For j = 2 To 13
         kq(k + 1, j) = dl(i + j - 2, 1)
         kq(k + 2, j) = dl(i + j - 2, 8)
         kq(k + 3, j) = dl(i + j - 2, 9)
         kq(k + 4, j) = dl(i + j - 2, 39)
      Next
      k = k + 4
   End If
Next
Sheets("bang tick day").[O3].Resize(k, 13) = kq
End Sub

 

[ptm0412]

Code cho bài này cũng không khó lắm nhưng có điều bị đảo dòng tại sheet kêt quả

Đảo thứ tự 1, 8, 9, 39 thành 9, 39, 1, 8 sẽ ra kết quả đúng dòng

 

[sealand]

Bài này do tác giả hỏi trên mảng chứ thực tế vẫn có thể sử lý bằng cách khác được.
Mình đưa 1 phương án khác bạn tham khảo thêm

Option Explicit
Sub Test()
Dim Mg1, k, i, Td(1 To 4, 1 To 1)
Sheets("bang tick day").[B3:N65536].ClearContents
Td(1, 1) = Sheets("SOC").[R1]
Td(2, 1) = Sheets("SOC").[AV1]
Td(3, 1) = Sheets("SOC").[J1]
Td(4, 1) = Sheets("SOC").[Q1]
With WorksheetFunction
For i = 1 To Sheets("SOC").[j65536].End(3).Row Step 12
Sheets("bang tick day").[C3:N3].Offset(k, -1).Resize(4) = Td
Sheets("bang tick day").[C3:N3].Offset(k) = .Transpose(Sheets("SOC").[R1].Offset(i).Resize(12))
Sheets("bang tick day").[C3:N3].Offset(k + 1) = .Transpose(Sheets("SOC").[AV1].Offset(i).Resize(12))
Sheets("bang tick day").[C3:N3].Offset(k + 2) = .Transpose(Sheets("SOC").[J1].Offset(i).Resize(12))
Sheets("bang tick day").[C3:N3].Offset(k + 3) = .Transpose(Sheets("SOC").[Q1].Offset(i).Resize(12))
k = k + 4
Next
End With
End Sub