Gán gt vào Cell theo DK = VBA

[ThuNghi]

Gán gt vào Cell theo DK=VBA

Tôi đang làm file theo dõi bảo trì mà vướng chưa giải quyết, lùng bùng.
Gán ký tự "O" vào các cell trong sh theo dk sau:
- Ngày > ngày đầu và < ngày cuối
- Line = line (cho trước)
- Số hạng mục của line (cho trước).
- Những ngày là CN thì không làm, ngày hôm sau, lấy những hạng mục kế.
Tôi đang lùng bùng lúc nào nên skip, lúc nào không trong Code sau:

-------------------------------------------------
Sub BaoTri()
With Application
'.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Dim i As Integer, j As Integer, k As Integer, t As Integer, x As Integer
Dim iDate As Date, jDate As Date
Dim days As Range, FDay As Range, LDay As Range
'Tao Application.WorksheetFunction - TuanVNI
Dim fn As WorksheetFunction
Set fn = Application.WorksheetFunction
S04.Select
Range(Cells(5, 4), Cells(500, 44)).ClearContents
'Xac dinh ngay dau
iDate = Cells(2, 1).Value
'xac dinh cot dau ' gan match ngay dau
Set FDay = Cells(2, 1)
t = fn.Match(FDay, Range("days"), 0) + 2
Set LDay = Cells(2, 2)
x = fn.Match(LDay, Range("days"), 0) + 2
j = 0
k = Cells(2, 3).Value 'so may sc cua line
For i = 1 To x - t + 1
'nho xu ly ngay dau la cn
For j = 0 To k - 1
'nen co gioi han cot va dong
'If Cells(4 + i, 3).Value <> "L1" Then
Cells(5 + k * (i - 1) + j, i + t).Value = "O"
Next j
Next i
bien:
With Application
'.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
-------------------------------------------------

Nhờ các bạn chỉ logich trong các tham số i,j,k,t. Các bạn xem file sau, sh PM-KQ là kết quả cần theo bài.
Cám ơn nhiều!
File này của thanhtri up mà tôi không làm được.

 

[anhtuan1066]

Chào bạn ThuNghi... Rất cám ơn bạn đã nhiệt tình... Theo tôi thì mục tiêu cuối cùng là cách sắp xếp máy bên sheet Schedule... còn chuyện gán chử "O" bên sheet PM thì đã có công thức đãm nhiệm rồi...
Tôi gữi file này mô tả cách sắp xếp máy... Bạn xem coi có giúp ích dc gì ko nha!
ANH TUẤN...

 

[ThuNghi]

Tôi muốn tự động hóa = VBA, với lại đó cũng là yêu cầu của nhiều công việc lắm. Quan trọng là hiểu về logich, có cần thiết phải nhiều tham số quá không.
Bác Voda giúp em đi.

 

[anhtuan1066]

Tôi gán dc chử "O" vào, "né" dc ngày CN và ngày lễ chỉ bằng công thức... còn khi thay đỗi kế hoach thì chẳng biết cách nào đễ sắp xếp lại máy 1 cách tự động cả... Bạn xem thêm file này nữa nha! (Quan trọng vẫn là cách sắp xếp bên sheet Schedule... sắp dc rồi thì sheet PM sẽ tự động gán chử "O" vào thôi)
ANH TUẤN

 

[anhtuan1066]

Bạn ThuNghi ơi... cái này sử dụng dc cho rất nhiều công việc đấy! Chúc bạn thành công đễ tôi còn dc... hưởng...
Cám ơn trước nha!
ANH TUẤN

 

[OverAC]

Bác thử đoạn code em chỉnh lại xem sao

------------------------
Sub BaoTri()
With Application
'.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Dim i As Integer, j As Integer, k As Integer, t As Integer, x As Integer, Songay As Interger
Dim iDate As Date, jDate As Date
Dim days As Range, FDay As Range, LDay As Range
'Tao Application.WorksheetFunction - TuanVNI
Dim fn As WorksheetFunction
Set fn = Application.WorksheetFunction
S04.Select
Range(Cells(5, 4), Cells(500, 44)).ClearContents
'Xac dinh ngay dau
iDate = Cells(2, 1).Value
'xac dinh cot dau ' gan match ngay dau
Set FDay = Cells(2, 1)
t = fn.Match(FDay, Range("days"), 0) + 2
Set LDay = Cells(2, 2)
x = fn.Match(LDay, Range("days"), 0) + 2
j = 0
k = Cells(2, 3).Value 'so may sc cua line
Songay = x - t + 1
For i = 1 To Songay
'nho xu ly ngay dau la cn
For j = 0 To k - 1
'nen co gioi han cot va dong
'If Cells(4 + i, 3).Value <> "L1" Then

If fn.WEEKDAY(Cells(4, i + t) = 0 then
i = i + 1
l = l + 1
End if
Cells(5 + k * (i - 1 -l) j , i + t).Value = "O"

Next j
Next i
bien:
With Application
'.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

 

[ThuNghi]

Bác Bình, nó chạy không theo trật tự nào cả. Quan trọng là gặp CN thì skip cột nhưng dòng không vẫn skip.

 

[digita]

Chào bạn Thu Nghi,

Đọc qua cái post của bạn thì tôi không rõ yêu cầu là gì. Nhờ bạn diển đạt lại chi tiết hơn về câu hỏi đặt ra và kèm thí dụ cụ thể. Càng nhiều chi tiết càng tốt để tôi có thễ giúp được phần nào.

Mến chào

 

[ThuNghi]

Cám ơn bạn nhiều!
Tôi up file .zip lên nhé, muốn kết qủa như sh PM-KQ, tôi chả biết diễn đạt thế nào.
Bổ sung thêm, nếu gán đến dòng cuối của L1 mà vẫn còn <ngày cuối, trở lên lại dòng đầu L1.
Cụ thể: Nếu số ngày bảo trì là 20, mỗi ngày 4 máy L1, giả sử không có CN.
Thì phải bảo trì 20x4 = 80 máy, mà line L1 chỉ có 30 máy tức là hết 30 máy lại quay lại dòng đầu L1.
Bạn cố nắm bắt nhé.
Đây hơi giống bài toán: 1 +j+k*i (k là số máy, i =1 to songay, j = 1 to số máy, là số dòng)
if k*i > j => j=1

 

[digita]

Cám ơn Thu Nghi đã chuyền file qua zip giùm.

Bạn thử giùm cái này coi đúng chưa nhá.

Mến chào

 

[OverAC]

Hôm qua viết code trực tiếp nên hơi ẩu. Anh thử đoạn này xem sao.

Sub BaoTri()
Dim i As Integer, j As Integer, k As Integer, t As Integer, x As Integer
Dim SoNgay As Integer
Dim iDate As Date, jDate As Date
Dim days As Range, FDay As Range, LDay As Range
Dim fn As WorksheetFunction
    
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    'Tao Application.WorksheetFunction - TuanVNI
    Set fn = Application.WorksheetFunction
    S04.Select
    Range(Cells(5, 4), Cells(500, 44)).ClearContents
    'Xac dinh ngay dau
    iDate = Cells(2, 1).Value
    
    'xac dinh cot dau ' gan match ngay dau
    Set FDay = Cells(2, 1)
    t = fn.Match(FDay, Range("days"), 0) + 2
    
    Set LDay = Cells(2, 2)
    x = fn.Match(LDay, Range("days"), 0) + 2
    
    j = 0
    k = Cells(2, 3).Value 'so may sc cua line
    
    SoNgay = x - t + 1
    l = 0
    For i = 1 To SoNgay
    'nho xu ly ngay dau la cn
        For j = 0 To k - 1
        'nen co gioi han cot va dong
            If Cells(5 + k * (i - 1 - l) + j, 3).Value = Cells(1, 4).Value Then
                If fn.Weekday(Cells(4, i + t), 1) = 1 Then
                    i = i + 1
                    SoNgay = SoNgay - 1
                    l = l + 1
                End If
                
                Cells(5 + k * (i - 1 - l) + j, i + t).Value = "O"
            
            End If
        Next j
    Next i
bien:
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

 

[ThuNghi]

Cám ơn rất nhiều.
Giúp thêm 1 chút nữa nhé.
somay = fn.CountIf(Range("line"), "L1") đếm bao nhiêu L1
if k * (i - 1 - L) + j > somay, i.g còn ngày phải bảo trì mà hết máy, thì quay lại máy đầu (L1 dòng đầu tiên).

 

[ThuNghi]

Nhờ các bạn chỉ giúp thêm về vấn đề gán gt.
Ví dụ ta có:
L1 có 3 máy, mà ta bảo trì 10 ngày mỗi ngày 2 máy =>
Ngày 1: 2 máy: máy 1 + máy 2
Ngày 2: 2 máy: máy 3 + máy 1
Ngày 3: 2 máy: máy 2 + máy 3
Do mỗi ngày bảo trì chỉ 2 máy nên sang ngày thứ 2 còn 1 máy 3 và quay lại máy 1. Phần này tôi diễn giải trong sh PM-KQ, phần tô đỏ là phần cần phải thêm, phần tô vàng thì code sau đã OK.
Các bạn chịu khó xem nhé, vấn đề lúc này là khi số ngày bảo trì x số máy bt/ngày >= số máy, thì qua trở về dòng đầu của line đó.
Cám ơn các bạn nhiều.

Option Explicit
Sub BaoTri()
'Tham khao OverAC&Digita
Dim i As Integer, j As Integer, k As Integer, m As Integer
Dim t As Integer, x As Integer, n As Integer
Dim SoNgay As Integer, SoMay As Integer
Dim iDate As Date, jDate As Date
Dim days As Range, FDay As Range, LDay As Range
Dim line As Range, FLine As Range, FRow As Integer, iCol As Integer
Dim LCount As Integer, somay_ngay As Integer
Dim fn As WorksheetFunction

With Application
' .Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'Tao Application.WorksheetFunction - TuanVNI
Set fn = Application.WorksheetFunction
S04.Select
Range(Cells(5, 4), Cells(500, 44)).ClearContents
Range("AT4:AU10").ClearContents
'Xac dinh ngay dau
iDate = Cells(2, 1).Value
'xac dinh cot dau ' gan match ngay dau
Set FDay = Cells(2, 1)
t = fn.Match(FDay, Range("days"), 0) + 2
Set LDay = Cells(2, 2)
x = fn.Match(LDay, Range("days"), 0) + 2
'Cot cuoi cua Line
iCol = S04.Cells(2, Columns.Count).End(xlToLeft).Column - 3
For n = 1 To iCol
Set FLine = Cells(2, 3 + n)
If Cells(2, 3 + n).Value = "" Then
GoTo trolai:
Else
FRow = fn.Match(FLine, Range("line"), 0)
LCount = fn.CountIf(Range("line"), FLine)
End If
SoMay = fn.CountIf(Range("line"), Cells(1, 3 + n).Value) 'dem so may la Cells(2,3+n)
k = Cells(2, 3).Value 'so may sc cua line
j = 0
SoNgay = x - t + 1
'somay_ngay = fn.Min(SoNgay * k, LCount)
m = 0
'xem lai songay va so may
For i = 1 To SoNgay
'nho xu ly ngay dau la cn
For j = 0 To k - 1
'nen co gioi han cot va dong, them tim thay L1,Ln
If Cells(FRow - 1 + 5 + k * (i - 1 - m) + j, 3).Value = Cells(2, 3 + n).Value Then
If Weekday(Cells(4, i + t), 1) = 1 Then
i = i + 1
SoNgay = SoNgay - 1
m = m + 1
End If
Cells(FRow - 1 + 5 + k * (i - 1 - m) + j, i + t).Value = "O"
'gan so may moi line va so may da bao tri
Cells(n + 3, 46).Value = k * (i - 1 - m) + j + 1
Cells(n + 3, 47).Value = LCount
If Cells(n + 3, 46).Value >= LCount Then
'luc nay lam sao dong tro ve dau, cot van la cot khi nao het k thi nhay cot
'MsgBox (Cells(n + 3, 46).Value & "-" & j)
GoTo trolai:
End If
End If
Next j
Next i
trolai:
Next n

With Application
'.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

 

[ThuNghi]

Có khi nói theo bài, các bạn không hình dung, vd cụ thể sau:
1 lớp có 20 HS theo thứ tự HS01, HS02...HS20. Có chương trình cho sữa từ ngày 15/07/07-20/07/07 (Có 1 CN), mỗi ngày sẽ phát cho 6 hs theo thứ tự mã HS, mỗi em 1 hộp trừ CN và lễ. Như vậy, 15/07/07 là CN-nghỉ,
- Ngày 16 phát 6, từ HS01-HS06
- Ngày 17 phát 6, từ HS07-HS12
- Ngày 18 phát 6, từ HS13-HS18
- Ngày 19 phát 6, trong đó 2 cho HS19 và HS20, còn 4 cho HS01-HS04
- Ngày 20 phát 6, từ HS05-HS10 (hết đợt)

Nếu có kỳ khác thì sẽ bắt đầu là HS11.
Lưu ý, k là số phát mỗi ngày, có thể thay đổi.
Nhờ các bạn lập cho 1 sh phân phối cụ thể về nhận sữ để phụ huynh khỏi kiện. Phụ huynh dạo này khó lắm.
Cám ơn nhiều.

 

[ThuNghi]

To thanhtri & anhtuan1066
Các bạn xem file sau có đúng 1 chút nào ý các bạn không.
Tạm thời chỉ làm 1 lệnh số 1 theo sh KH, nếu OK sẽ triển khai tiếp lệnh số 2 -> n, trên sh KH bạn chỉ cần nhập ngày đầu và ngày cuối (cùng tháng) và số máy cần bảo trì. Chạy code baotri là OK.
Sẽ phát triển tiếp, lệnh số 2, sẽ bảo trì tiếp những máy mà lệnh 1 chấm dứt.
ig nếu lệnh 1 chấm dứt ở máy số 6, line 1 thì lệnh số 2 sẽ tiếp tục từ máy 7.
Logich còn thế nào, sẽ edit từ từ.