Mình thường cắt/xóa bớt các ngày quá khứ đi khi không cần thiết nữa,form của mình sẽ liên tục 31 cột các ngày liền nhau nếu xóa 5 ngày quá khứ thì sẽ phải thêm 5 ngày phía sau, dù gì đi nữa nếu dữ liệu lấy chuẩn theo ngày khi cột ngày ở vị trí nào đi nữa thì luôn có cảm giác yên tâm hơn khi không phải kiểm tra lại ngày tháng phải không bạn.
OT thấy code của Thầy @Ba Tê viết rất tối ưu nên chỉnh lại một chút trong đoạn từ "With Sheets("TONGHOP") đến End With", bạn thử đảo lộn các ngày của sheet "TONGHOP" xem được không ạ?
'....
With Sheets("TONGHOP")
sArr = .Range("A2", .Range("A2").End(xlDown)).Value
'~~~~~~~~~~~~~~~~~~~~~~~~~~~ thêm đoạn này
Dim Ngay(), iDate As Date
Ngay = .Range("C1", .Range("C1").End(xlToRight)).Value
J = UBound(Ngay, 2)
For I = 1 To J
iDate = Ngay(1, I)
If Not Dic.Exists(iDate) Then
Dic.Add iDate, I
End If
Next I
'~~~~~~~~~~~~~~~~~~~~~~~~~~~ kết thúc thêm
R2 = UBound(sArr)
ReDim KQ(1 To R2, 1 To 31)
For I = 1 To R2
Dic.Item(sArr(I, 1)) = I
Next I
'---------------------------------------
For I = 1 To R
For J = 4 To MaxCol Step 2
If Dic.Exists(dArr(I, J)) Then
'~~~~~~~~~~~~~~~~~~~~~~~~~~~ thêm + sửa đoạn này
iDate = dArr(I, 1)
Col = Dic(iDate) 'Day(dArr(I, 1))
'~~~~~~~~~~~~~~~~~~~~~~~~~~~ kết thúc thêm
Rws = Dic.Item(dArr(I, J))
KQ(Rws, Col) = KQ(Rws, Col) + dArr(I, 3) * dArr(I, J + 1)
End If
Next J
Next I
.Range("C2").Resize(R2, 31) = KQ
End With
' ...Lần trước con có thử làm bài này nhưng code dài quá, sau đó con thấy cách làm của Thầy nên con bỏ luôn cách của con luôn
Nói chung là đề bài quá lòng vòng, hiểu sao làm vậy, dùng nhiều mảng tạm nên code cũng lòng vòng.Lần trước con có thử làm bài này nhưng code dài quá, sau đó con thấy cách làm của Thầy nên con bỏ luôn cách của con luôn
Thế bạn có bị ai không cho phép gộp 2 biểu đó lại hay không?
Sub GopBang()
Dim J As Long, Cot As Integer, W As Integer, Hg As Byte
Dim Arr(), Ma As String
With Sheets("DM_A")
Arr() = [B3].CurrentRegion.Offset(3).Value
ReDim aKQ(1 To UBound(Arr()), 1 To 17)
[E2].Resize(UBound(Arr()), 17).Value = aKQ()
For J = 1 To UBound(Arr())
If Arr(J, 1) <> Ma Then
W = W + 1: Hg = 1
For Cot = 1 To 3
aKQ(W, Cot) = Arr(J, Cot)
Next Cot
Ma = Arr(J, 1)
Else
Hg = Hg + 1
For Cot = 2 * Hg To 2 * Hg + 1
aKQ(W, Cot) = Arr(J, IIf(Cot = 2 * Hg, 2, 3))
Next Cot
End If
Next J
End With
[E2].Resize(W, 17).Value = aKQ()
End SubBác SA ơi, con thấy chuyển 'DM_B' giống cấu trúc 'DM_A' thì mới ra dáng CSDL hơn ạ.
Nếu có vấn đề gì, Bác góp ý thêm cho con ạ:Thì cũng phải nhường ai đó hay ngay chính bạn thử viết chứ nhỉ, Ăn 1 mình đau tức, làm 1 mình cực thân mà!
Option Explicit
Sub chuyenForm_B_to_A()
Dim data(), res(), i As Long, j As Long, k As Long, sMaMe As String, sMaCon As String, dinhmuc As Double
With ThisWorkbook.Worksheets("DM_B")
i = .Cells(.Rows.Count, "A").End(xlUp).Row
If i > 2 Then data = .Range("A3:G" & i).Value Else Exit Sub
ReDim res(1 To UBound(data, 1), 1 To 3)
For i = LBound(data, 1) To UBound(data, 1)
If Not TypeName(data(i, 1)) Like "Error*" Then
For j = 2 To UBound(data, 2) - 1 Step 2
sMaMe = data(i, 1): sMaCon = data(i, j): dinhmuc = data(i, j + 1)
If Len(sMaCon) > 0 Then
k = k + 1
res(k, 1) = sMaMe
res(k, 2) = sMaCon
res(k, 3) = dinhmuc
End If
Next j
End If
Next i
End With
With ThisWorkbook.Worksheets("DM_A")
i = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
If k > 0 Then .Cells(i, 1).Resize(k, 3).Value = res
End With
End Sub| Nguyên liệu 2 | Nguyên liệu 3 | Nguyên liệu 4 | ||||||||||||||||
| Mã mẹ | Mã con | Định mức cần cho mã con | Mã con | Định mức cần cho mã con | Mã con | Định mức cần cho mã con | (Dòng DL) | |||||||||||
| AS02814 | AS00555 | 1 | AS00520 | 50 | ||||||||||||||
| AS02813 | AS00556 | 1 | AS00520 | 50 | ||||||||||||||
| AS02812 | AS00555 | 1 | AS00520 | 50 | ||||||||||||||
| AS02811 | AS00520 | 25 | 6 | |||||||||||||||
| AS02810 | AS00520 | 25 | ||||||||||||||||
| AS02809 | AS00625 | 1 | AS00520 | 50 | ||||||||||||||
| AS02808 | AS00520 | 50 | 9 | |||||||||||||||
| AS02807 | AS00556 | 1 | AS00520 | 50 | ||||||||||||||
| AS02806 | AS00616 | 0.5 | ||||||||||||||||
| AS02805 | AS00616 | 1 | ||||||||||||||||
| AS02804 | AS00520 | 1 | ||||||||||||||||
| AS02803 | AS00555 | 1 | AS00520 | 25 | ||||||||||||||
| AS02802 | AS00556 | 1 | AS00520 | 25 | ||||||||||||||
| AS01948 | AS00515 | 1 | AS00292 | 100 | 890 | |||||||||||||
| AS01947 | AS00292 | 25 | 891 | |||||||||||||||
| AS01946 | AS00520 | 2 | AS00292 | 50 | 892 | |||||||||||||
| AS01945 | AS00619 | 2 | AS00737 | 25 | 893 | |||||||||||||
| AS02801 | ||||||||||||||||||
| AS02800 | ||||||||||||||||||
| AS02799 | ||||||||||||||||||
| AS02798 | ||||||||||||||||||
| AS02797 | ||||||||||||||||||
| AS02796 | ||||||||||||||||||
| AS02795 | ||||||||||||||||||
| AS02794 | ||||||||||||||||||
| AS02793 | ||||||||||||||||||
| AS02792 | ||||||||||||||||||
| AS02791 | ||||||||||||||||||
| AS02790 |
Cảm ơn Bác Sa đã góp ý, Bác ơi con chưa hiểu các số mà Bác đánh trong cột (Dòng DL) có ý nghĩa gì, con kiểm tra thấy dữ liệu vẫn chuyển sang sheet "DM_A" bình thường ạ ạ.
Xin chào anh @ongke0711
, dạ cảm ơn đã ủng hộ và đồng quan điểm với OT ạ.
Ý mình là ở trang 'DM_B' này có 126 dòng không có số lượng định mức; & như vậy việc xử lý các dòng này (để tạo bảng với thiết kế mới) là vô nghĩa.
