Cảm ơn Bạn đã quan tâm ạ,
Có.
Lỡ đánh cược rồi.
Nếu là đánh cược thì có chia không? mà dù chia hay không thì tôi cũng không tham giaLỡ đánh cược rồi.
Con chào chú Mỹ,
Bạn không thì tôi theo thử (cược theo chứ không cần chia). Nhưng tôi chỉ theo phần "duyệt trên các cell [sic]" thôi.
Tô màu kẻ khung không phải lý do chính đáng, không duyệt. "Các vấn đề khác" là gì kể ra luôn đi nào.
Nếu là các mã hàng đặc biệt theo một danh sách cho sẵn thì phải tô màu mã đó Chú ạ.
Bác chỉ con thuật toán với ạ, con thử xem được không, con vướng cái khi ghép số vài chuỗi rồi thì không cộng tiếp vào được.
Tôi chỉ đang doạ thôi. Ngoài ra còn phải xem hết "các vấn đề khác", chỉ để chỉnh sửa tư duy cho đối tượng, chứ làm trên cell có vấn đề gì đâu. Chỉ chậm 1 chút thôi.
Cách trình bày kết quả có không thể hiện mối liên hệ giữa mã hàng và ca sản xuất, ví dụ mã hàng MH0011 sản xuất ca 3 nhưng ghi nhận ca 1
Sub ABC()
Dim rng As Range, S, fDay As Date, iDay As Date, iMonth&, maHang$
Dim sRow&, fRow&, i&, r&, iR&
With Sheets("Du_Lieu")
Set rng = .Range("A2", .Range("E" & Rows.Count).End(xlUp))
sRow = rng.Rows.Count
End With
With Sheets("Ket_Qua")
fDay = .Range("F3").Value: iMonth = Month(fDay)
fRow = 6 'Dong tieu de
r = fRow + Hour(rng(1, 3)) \ 6 + Int(rng(1, 3) - fDay) * 3
.Range("E" & r & ":G102").ClearContents 'Xoa du lieu
For i = 1 To sRow
If Month(rng(i, 3)) = iMonth Then 'xet thang
r = fRow + Hour(rng(i, 3)) \ 6 + Int(rng(i, 3) - fDay) * 3 'thu tu dong ket qua
If .Cells(r, 5).Value = Empty Then 'So chung tu
.Cells(r, 5).Value = rng(i, 1) & ":" & rng(i, 2)
Else
.Cells(r, 5).Value = .Cells(r, 5).Value & Chr(10) & rng(i, 1) & ":" & rng(i, 2)
End If
If maHang <> rng(i, 5).Value And iDay <> Int(rng(i, 3)) Then
iR = r 'Dong ma hang
iDay = Int(rng(i, 3)) 'Ngay
End If
If .Cells(iR, 6).Value = Empty Then
.Cells(iR, 6).Value = rng(i, 5).Value
.Cells(iR, 7).Value = rng(i, 2).Value
maHang = rng(i, 5).Value
Else
If maHang <> rng(i, 5).Value Then 'Ma hang + so luong
maHang = rng(i, 5).Value
.Cells(iR, 6).Value = .Cells(iR, 6).Value & Chr(10) & maHang
.Cells(iR, 7).Value = .Cells(iR, 7).Value & Chr(10) & rng(i, 2).Value
Else
S = Split(.Cells(iR, 7).Value, Chr(10))
S(UBound(S)) = S(UBound(S)) + rng(i, 2).Value
.Cells(iR, 7).Value = Join(S, Chr(10))
End If
End If
End If
Next i
End With
End SubCảm ơn Bác Hiếu đã giúp đỡ con ạ, code ngắn hơn con tưởng nhiều Bác ạ.
Con chào Bác Hiếu,
Chỉnh lại
Sub XYZ()
Dim rng As Range, S, fDay As Date, iDay As Date, iMonth&, maHang$, soCT$
Dim sRow&, fRow&, i&, r&, j&, ctR&, maR&
With Sheets("Du_Lieu")
Set rng = .Range("A2", .Range("E" & Rows.Count).End(xlUp))
sRow = rng.Rows.Count
End With
With Sheets("Ket_Qua")
fDay = .Range("F3").Value: iMonth = Month(fDay)
fRow = 6 'Dong tieu de
r = fRow + Hour(rng(1, 3)) \ 6 + Int(rng(1, 3) - fDay) * 3
.Range("E" & r & ":G102").ClearContents 'Xoa du lieu
For i = 1 To sRow
If Month(rng(i, 3)) = iMonth Then 'xet thang
r = fRow + Hour(rng(i, 3)) \ 6 + Int(rng(i, 3) - fDay) * 3 'thu tu dong ket qua
If soCT <> rng(i, 1).Value Then 'So chung tu moi
soCT = rng(i, 1).Value
ctR = r 'dong so CT
If .Cells(r, 5).Value = Empty Then
.Cells(r, 5).Value = rng(i, 1) & ":" & rng(i, 2)
Else
.Cells(r, 5).Value = .Cells(r, 5).Value & Chr(10) & rng(i, 1) & ":" & rng(i, 2)
End If
Else
j = InStrRev(.Cells(ctR, 5), ":")
.Cells(ctR, 5) = Mid(.Cells(ctR, 5), 1, j) & Val(Mid(.Cells(ctR, 5), j + 1, 16)) + rng(i, 2)
End If
If maHang <> rng(i, 5).Value Then 'Ma hang moi
maHang = rng(i, 5).Value
maR = r 'Dong ma hang
If .Cells(r, 6).Value = Empty Then
.Cells(r, 6).Value = rng(i, 5).Value
.Cells(r, 7).Value = rng(i, 2).Value
Else
.Cells(r, 6).Value = .Cells(r, 6).Value & Chr(10) & maHang
.Cells(r, 7).Value = .Cells(r, 7).Value & Chr(10) & rng(i, 2).Value
End If
Else
S = Split(.Cells(maR, 7).Value, Chr(10))
S(UBound(S)) = S(UBound(S)) + rng(i, 2).Value
.Cells(maR, 7).Value = Join(S, Chr(10))
End If
End If
Next i
End With
End SubCon cảm ơn Bác Hiếu nhiều ạ, con đã thấy kết quả đúng như ý của mình rồi Bác ạ.
