Sắp xếp ngẫu nhiên có điều kiện

Liên hệ QC
H

hungdiep85

Thành viên thường trực
Tham gia
1/6/09
Bài viết
218
Được thích
23
Giới tính
Nam
Chào các Anh Chị
nhờ anh chị giúp em đoạn code

sắp xếp ngẫu nhiên theo B3 đến D162, mỗi tổ sẽ sản xuất "Mẫu, Màu, Đế".

Điều kiện: trong thời gian 2 tiếng màu và đế sẽ không trùng với tổ khác và "Màu, Đế" đã sản xuất sẽ không sản xuất lại trong một ngày :

ví dụ "Màu xanh, Đế đỏ" và "Màu đỏ, Đế xanh" sẽ không sản xuất trong một ngày. (chỉ sản xuất một trong hai)

và thời gian 01:00PM đến 03:00PM sẽ không sản xuất màu hoạt đế có màu trắng và màu đen.

Em cảm ơn trước ạ
 

File đính kèm

  • Sắp xếp ngẫu nhiên có điều kiện.xlsx
    11.2 KB · Đọc: 14
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
hungdiep85 đã viết:
Chào các Anh Chị
nhờ anh chị giúp em đoạn code

sắp xếp ngẫu nhiên theo B3 đến D162, mỗi tổ sẽ sản xuất "Mẫu, Màu, Đế".

Điều kiện: trong thời gian 2 tiếng màu và đế sẽ không trùng với tổ khác và "Màu, Đế" đã sản xuất sẽ không sản xuất lại trong một ngày :

ví dụ "Màu xanh, Đế đỏ" và "Màu đỏ, Đế xanh" sẽ không sản xuất trong một ngày. (chỉ sản xuất một trong hai)

và thời gian 01:00PM đến 03:00PM sẽ không sản xuất màu hoạt đế có màu trắng và màu đen.

Em cảm ơn trước ạ
Nhấp chuột vào đây để mở rộng...
Có nhiều thứ còn mù mờ: "tổ", "2 tiếng", " 01:00PM đến 03:00PM" ...
 
Upvote 0
HieuCD đã viết:
Có nhiều thứ còn mù mờ: "tổ", "2 tiếng", " 01:00PM đến 03:00PM" ...
Nhấp chuột vào đây để mở rộng...
Dạ,
“Tổ là 1 nhóm nhân viên phụ trách công việc đó, có 5 hàng 01PM ý là 5 tổ (5 nhóm), 1 hàng 1 tổ (nhóm)”
“2 tiếng ý là 2 giờ đồng hồ, dùng 2 giờ đồng hồ để sản xuất mặt hàng đó.
“01:00PM đến 03:00PM ý là sản phẩm xanh đỏ sản xuất trong thời gian từ 13 giờ đến 15 giờ là ngừng không làm nữa. Tổ đó chuyển qua làm sản phẩm khác.
 
Upvote 0
hungdiep85 đã viết:
Dạ,
“Tổ là 1 nhóm nhân viên phụ trách công việc đó, có 5 hàng 01PM ý là 5 tổ (5 nhóm), 1 hàng 1 tổ (nhóm)”
“2 tiếng ý là 2 giờ đồng hồ, dùng 2 giờ đồng hồ để sản xuất mặt hàng đó.
“01:00PM đến 03:00PM ý là sản phẩm xanh đỏ sản xuất trong thời gian từ 13 giờ đến 15 giờ là ngừng không làm nữa. Tổ đó chuyển qua làm sản phẩm khác.
Nhấp chuột vào đây để mở rộng...
Cho ví dụ trên file và giải thích dựa trên ví dụ
 
Upvote 0
HieuCD đã viết:
Cho ví dụ trên file và giải thích dựa trên ví dụ
Nhấp chuột vào đây để mở rộng...
dạ, em đã thêm ví dụ
dạ, "Tổ (Nhóm)"
có thể thay đổi theo đơn hàng nhiều hay ít, có lúc chỉ có 2 tổ, có lúc 6, 7 tổ làm việc

và thời gian 01:00PM đến 03:00PM sẽ không sản xuất màu hoạt đế có màu trắng và màu đen (phần này em thiếu ví dụ trong file)

Em cảm ơn anh nhiều lắm
 

File đính kèm

  • Sắp xếp ngẫu nhiên có điều kiện (1).xlsx
    15.3 KB · Đọc: 12
Lần chỉnh sửa cuối:
Upvote 0
hungdiep85 đã viết:
dạ, em đã thêm ví dụ
dạ, "Tổ (Nhóm)"
có thể thay đổi theo đơn hàng nhiều hay ít, có lúc chỉ có 2 tổ, có lúc 6, 7 tổ làm việc

và thời gian 01:00PM đến 03:00PM sẽ không sản xuất màu hoạt đế có màu trắng và màu đen (phần này em thiếu ví dụ trong file)

Em cảm ơn anh nhiều lắm
Nhấp chuột vào đây để mở rộng...
Thời gian làm việc không rỏ, 8:00 là từ 8:00-10:00, vậy 12:00 và 1:00 là từ giờ? đến giờ?
Nên chia 2 cột "từ" giờ và "đến" giờ và liệt kê toàn bộ trong ngày
 
Upvote 0
hungdiep85 đã viết:
dạ, em đã thêm ví dụ
dạ, "Tổ (Nhóm)"
có thể thay đổi theo đơn hàng nhiều hay ít, có lúc chỉ có 2 tổ, có lúc 6, 7 tổ làm việc

và thời gian 01:00PM đến 03:00PM sẽ không sản xuất màu hoạt đế có màu trắng và màu đen (phần này em thiếu ví dụ trong file)

Em cảm ơn anh nhiều lắm
Nhấp chuột vào đây để mở rộng...
dạ,
em đã thêm (2 cột "từ" giờ và "đến" giờ và liệt kê toàn bộ trong ngày)
Em cảm ơn anh
 

File đính kèm

  • Sắp xếp ngẫu nhiên có điều kiện (1) (1).xlsx
    15.5 KB · Đọc: 11
Upvote 0
hungdiep85 đã viết:
dạ,
em đã thêm (2 cột "từ" giờ và "đến" giờ và liệt kê toàn bộ trong ngày)
Em cảm ơn anh
Nhấp chuột vào đây để mở rộng...
Chạy sub XYZ
Mã: 
Dim Res(), Dic As Object, Dic2 As Object, k&, d&

Sub XYZ()
  Dim sArr1(), sArr2()
  Dim ToDau&, sR1&, sR2&, n&, t&, fRow&, i&
 
  sArr1 = Range("B3:D82").Value:       sR1 = UBound(sArr1)
  sArr2 = Range("B83:D162").Value:     sR2 = UBound(sArr2)
  ReDim Res(1 To 25, 1 To 3)
  Set Dic = CreateObject("scripting.dictionary")
  Set Dic2 = CreateObject("scripting.dictionary")
 
  Randomize
  ToDau = Int(2 * Rnd)
  For n = 0 To 4
    For t = 1 To 5
      k = n * 5 + t
      d = 0
      If (k Mod 2) = ToDau Then
        Call CreateRes(sArr1, sR1)
      Else
        Call CreateRes(sArr2, sR2)
      End If
      If d = 100 Then
        fRow = n * 5 + 1
        For i = fRow To k - 1
          Dic2.Remove (Res(i, 2) & Res(i, 3))
          Dic2.Remove (Res(i, 3) & Res(i, 2))
        Next i
        n = n - 1: Exit For
      End If
    Next t
    Dic.RemoveAll
  Next n
  Range("I3").Resize(25, 3) = Res
End Sub

Private Sub CreateRes(ByRef sArr, ByVal sR&)
  Dim iR&, loai$, mau$, de$
 
  Do
    iR = Int(sR * Rnd + 1)
    loai = sArr(iR, 1): mau = sArr(iR, 2):     de = sArr(iR, 3)
    If loai <> Empty Then
      If Dic2.exists(mau & de) = False And Dic2.exists(de & mau) = False Then
        If Dic.exists(de) = False Then
          If Dic.exists(mau) = False Then
            Res(k, 1) = loai: Res(k, 2) = mau: Res(k, 3) = de
            Dic.Add mau, "": Dic.Add mau & "|", "": Dic.Add de, ""
            Dic2.Add mau & de, ""
            Dic2.Add de & mau, ""
            sArr(iR, 1) = Empty
            Exit Do
          Else
            d = d + 1
            If d = 100 Then Exit Do
          End If
        End If
      End If
    End If
  Loop Until k = 0
End Sub
 
Upvote 0
HieuCD đã viết:
Chạy sub XYZ
Mã: 
Dim Res(), Dic As Object, Dic2 As Object, k&, d&

Sub XYZ()
  Dim sArr1(), sArr2()
  Dim ToDau&, sR1&, sR2&, n&, t&, fRow&, i&

  sArr1 = Range("B3:D82").Value:       sR1 = UBound(sArr1)
  sArr2 = Range("B83:D162").Value:     sR2 = UBound(sArr2)
  ReDim Res(1 To 25, 1 To 3)
  Set Dic = CreateObject("scripting.dictionary")
  Set Dic2 = CreateObject("scripting.dictionary")

  Randomize
  ToDau = Int(2 * Rnd)
  For n = 0 To 4
    For t = 1 To 5
      k = n * 5 + t
      d = 0
      If (k Mod 2) = ToDau Then
        Call CreateRes(sArr1, sR1)
      Else
        Call CreateRes(sArr2, sR2)
      End If
      If d = 100 Then
        fRow = n * 5 + 1
        For i = fRow To k - 1
          Dic2.Remove (Res(i, 2) & Res(i, 3))
          Dic2.Remove (Res(i, 3) & Res(i, 2))
        Next i
        n = n - 1: Exit For
      End If
    Next t
    Dic.RemoveAll
  Next n
  Range("I3").Resize(25, 3) = Res
End Sub

Private Sub CreateRes(ByRef sArr, ByVal sR&)
  Dim iR&, loai$, mau$, de$

  Do
    iR = Int(sR * Rnd + 1)
    loai = sArr(iR, 1): mau = sArr(iR, 2):     de = sArr(iR, 3)
    If loai <> Empty Then
      If Dic2.exists(mau & de) = False And Dic2.exists(de & mau) = False Then
        If Dic.exists(de) = False Then
          If Dic.exists(mau) = False Then
            Res(k, 1) = loai: Res(k, 2) = mau: Res(k, 3) = de
            Dic.Add mau, "": Dic.Add mau & "|", "": Dic.Add de, ""
            Dic2.Add mau & de, ""
            Dic2.Add de & mau, ""
            sArr(iR, 1) = Empty
            Exit Do
          Else
            d = d + 1
            If d = 100 Then Exit Do
          End If
        End If
      End If
    End If
  Loop Until k = 0
End Sub
Nhấp chuột vào đây để mở rộng...
Anh ơi, quá tuyệt vời rồi,
còn một số vấn đề nhờ anh chỉnh Thêm và dạy, vì code khó quá để em có thể tự chỉnh.

Chỉnh:
cột I sẽ không thay đổi, Cột J và K sẽ dựa theo cột I để lấy màu và đế bên cột C và cột D , (vì là cột I là được phân công sẵn).

Thêm: Màu và Đế không sản xuất
trong thơi gian nào em muốn không chọn màu nào thì em để màu đó ở cột E,
ví dụ : "Trang, Den, " thì màu và đế đó sẽ không suất hiện ở Cột J và K

Dạy
thêm dữ liệu cột B, C, D thì thêm như thế nào
thêm cột J và cột K nhiêu hơn 27 hàng thì thêm như thế nào

Em cảm ơn anh nhiều
 

File đính kèm

  • Sắp xếp ngẫu nhiên có điều kiện (1) (2).xlsm
    27.5 KB · Đọc: 6
Upvote 0
hungdiep85 đã viết:
Anh ơi, quá tuyệt vời rồi,
còn một số vấn đề nhờ anh chỉnh Thêm và dạy, vì code khó quá để em có thể tự chỉnh.

Chỉnh:
cột I sẽ không thay đổi, Cột J và K sẽ dựa theo cột I để lấy màu và đế bên cột C và cột D , (vì là cột I là được phân công sẵn).

Thêm: Màu và Đế không sản xuất
trong thơi gian nào em muốn không chọn màu nào thì em để màu đó ở cột E,
ví dụ : "Trang, Den, " thì màu và đế đó sẽ không suất hiện ở Cột J và K

Dạy
thêm dữ liệu cột B, C, D thì thêm như thế nào
thêm cột J và cột K nhiêu hơn 27 hàng thì thêm như thế nào

Em cảm ơn anh nhiều
Nhấp chuột vào đây để mở rộng...
Có 11 màu, mỗi đợt 5 dòng cần 10 màu, bạn loại 2 màu không thể chạy được kết quả
Có bao nhiêu mẫu?
 
Upvote 0
HieuCD đã viết:
Có 11 màu, mỗi đợt 5 dòng cần 10 màu, bạn loại 2 màu không thể chạy được kết quả
Có bao nhiêu mẫu?
Nhấp chuột vào đây để mở rộng...
Dạ.
em mới thêm màu vào (15 Màu), màu nhiều lắm anh, có đến cả ngàn màu và đế,
mẫu thì có 4 mẫu
 

File đính kèm

  • Sắp xếp ngẫu nhiên có điều kiện (1) (4).xlsm
    32.7 KB · Đọc: 6
Upvote 0
hungdiep85 đã viết:
Dạ.
em mới thêm màu vào (15 Màu), màu nhiều lắm anh, có đến cả ngàn màu và đế,
mẫu thì có 4 mẫu
Nhấp chuột vào đây để mở rộng...
Xem cách thêm dữ liệu trong file
Lưu ý cột B,C.D phải được sort thứ tự theo cột B
Mã: 
Option Compare Text
Dim sArr(), Res(), Dic As Object, Dic2 As Object, d&

Sub XYZ()
  Dim aGio(), mau$, k&
  Dim n&, t&, fRow&, eRow&, sN&, i&, thua&
  Const SoTo& = 5
 
  Set Dic = CreateObject("scripting.dictionary")
  Set Dic2 = CreateObject("scripting.dictionary")
  eRow = Range("B" & Rows.Count).End(xlUp).Row
  For i = 3 To eRow
    If mau <> Range("B" & i).Value Then
      fRow = i
      mau = Range("B" & i).Value
    End If
    If mau <> Range("B" & i + 1).Value Then
      n = n + 1
      ReDim Preserve sArr(1 To n)
      sArr(n) = Range("B" & fRow & ":D" & i).Value
      Dic2.Item(mau) = n
    End If
  Next i
  aGio = Range("E3", Range("I" & Rows.Count).End(xlUp)).Value
 
  k = 0
  ReDim Res(1 To UBound(aGio), 1 To 2)
  sN = UBound(aGio) / SoTo - 1
  Randomize
  For n = 0 To sN
    For t = 1 To SoTo
      k = n * SoTo + t
      d = 0
      Call CreateRes(k, Dic2.Item(aGio(k, 5)), aGio(k, 1))
      If d = 100 Then
        fRow = n * SoTo + 1
        For i = fRow To k - 1
          Dic2.Remove (Res(i, 1) & Res(i, 2))
          Dic2.Remove (Res(i, 2) & Res(i, 1))
        Next i
        thua = thua + 1
        If thua = 1000 Then MsgBox ("So luong Mau qua it, Chiu thua!"): Exit Sub
        n = n - 1: Exit For
      Else
        thua = 0
      End If
    Next t
    Dic.RemoveAll
  Next n
  Range("J3").Resize(k, 2) = Res
  Dic2.RemoveAll
End Sub

Private Sub CreateRes(ByRef k, ByVal n&, ByVal unMau$)
  Dim sRow&, iR&, mau$, de$
 
  sRow = UBound(sArr(n))
  Do While k > 0
    iR = Int(sRow * Rnd + 1)
    mau = sArr(n)(iR, 2):     de = sArr(n)(iR, 3)
    If Dic2.exists(mau & de) = False And Dic2.exists(de & mau) = False Then
      If InStr(1, unMau, mau) = 0 And InStr(1, unMau, de) = 0 Then
        If Dic.exists(de) = False Then
          If Dic.exists(mau) = False Then
            Res(k, 1) = mau: Res(k, 2) = de
            Dic.Add mau, "": Dic.Add mau & "|", "": Dic.Add de, ""
            Dic2.Add mau & de, ""
            Dic2.Add de & mau, ""
            Exit Do
          Else
            d = d + 1
            If d = 100 Then Exit Do
          End If
        End If
      End If
    End If
  Loop
End Sub
 

File đính kèm

  • Sắp xếp ngẫu nhiên có điều kiện (1) (4).xlsm
    36.6 KB · Đọc: 8
Upvote 0
HieuCD đã viết:
Xem cách thêm dữ liệu trong file
Lưu ý cột B,C.D phải được sort thứ tự theo cột B
Mã: 
Option Compare Text
Dim sArr(), Res(), Dic As Object, Dic2 As Object, d&

Sub XYZ()
  Dim aGio(), mau$, k&
  Dim n&, t&, fRow&, eRow&, sN&, i&, thua&
  Const SoTo& = 5

  Set Dic = CreateObject("scripting.dictionary")
  Set Dic2 = CreateObject("scripting.dictionary")
  eRow = Range("B" & Rows.Count).End(xlUp).Row
  For i = 3 To eRow
    If mau <> Range("B" & i).Value Then
      fRow = i
      mau = Range("B" & i).Value
    End If
    If mau <> Range("B" & i + 1).Value Then
      n = n + 1
      ReDim Preserve sArr(1 To n)
      sArr(n) = Range("B" & fRow & ":D" & i).Value
      Dic2.Item(mau) = n
    End If
  Next i
  aGio = Range("E3", Range("I" & Rows.Count).End(xlUp)).Value

  k = 0
  ReDim Res(1 To UBound(aGio), 1 To 2)
  sN = UBound(aGio) / SoTo - 1
  Randomize
  For n = 0 To sN
    For t = 1 To SoTo
      k = n * SoTo + t
      d = 0
      Call CreateRes(k, Dic2.Item(aGio(k, 5)), aGio(k, 1))
      If d = 100 Then
        fRow = n * SoTo + 1
        For i = fRow To k - 1
          Dic2.Remove (Res(i, 1) & Res(i, 2))
          Dic2.Remove (Res(i, 2) & Res(i, 1))
        Next i
        thua = thua + 1
        If thua = 1000 Then MsgBox ("So luong Mau qua it, Chiu thua!"): Exit Sub
        n = n - 1: Exit For
      Else
        thua = 0
      End If
    Next t
    Dic.RemoveAll
  Next n
  Range("J3").Resize(k, 2) = Res
  Dic2.RemoveAll
End Sub

Private Sub CreateRes(ByRef k, ByVal n&, ByVal unMau$)
  Dim sRow&, iR&, mau$, de$

  sRow = UBound(sArr(n))
  Do While k > 0
    iR = Int(sRow * Rnd + 1)
    mau = sArr(n)(iR, 2):     de = sArr(n)(iR, 3)
    If Dic2.exists(mau & de) = False And Dic2.exists(de & mau) = False Then
      If InStr(1, unMau, mau) = 0 And InStr(1, unMau, de) = 0 Then
        If Dic.exists(de) = False Then
          If Dic.exists(mau) = False Then
            Res(k, 1) = mau: Res(k, 2) = de
            Dic.Add mau, "": Dic.Add mau & "|", "": Dic.Add de, ""
            Dic2.Add mau & de, ""
            Dic2.Add de & mau, ""
            Exit Do
          Else
            d = d + 1
            If d = 100 Then Exit Do
          End If
        End If
      End If
    End If
  Loop
End Sub
Nhấp chuột vào đây để mở rộng...
Dạ,
em đã áp dụng vào công việc cho ngày mai được luôn rồi à, hihihi..
nhưng em có sữa thủ công môt số trường hộp.

vì cứ 5 tổ màu được lặp lại, đôi lúc cần 6 tổ, 7 tổ, những tháng tết có ngày 20 tổ làm việc luôn, (phần màu 100% là đủ màu)

Anh có thể thêm giúp em phần Điền số tổ mong muốn
Ví dụ :
điền số 5, thì 5 tổ mới suất hiện lại màu củ. (file đang là 5 tổ)
điền số 6, thì 6 tổ mới suất hiện lại màu củ. (mong muốn)
điền số 7, thì 7 tổ mới suất hiện lại màu củ. (mong muốn)

Em cảm ơn anh nhiều lắm
 

File đính kèm

  • Sắp xếp ngẫu nhiên có điều kiện (1) (5).xlsm
    48.3 KB · Đọc: 5
Upvote 0
hungdiep85 đã viết:
Dạ,
em đã áp dụng vào công việc cho ngày mai được luôn rồi à, hihihi..
nhưng em có sữa thủ công môt số trường hộp.

vì cứ 5 tổ màu được lặp lại, đôi lúc cần 6 tổ, 7 tổ, những tháng tết có ngày 20 tổ làm việc luôn, (phần màu 100% là đủ màu)

Anh có thể thêm giúp em phần Điền số tổ mong muốn
Ví dụ :
điền số 5, thì 5 tổ mới suất hiện lại màu củ. (file đang là 5 tổ)
điền số 6, thì 6 tổ mới suất hiện lại màu củ. (mong muốn)
điền số 7, thì 7 tổ mới suất hiện lại màu củ. (mong muốn)

Em cảm ơn anh nhiều lắm
Nhấp chuột vào đây để mở rộng...
Bạn cũng rất hài hước ấy chứ nhỉ. Sửa (chữa) thì viết là sữa (đặc có đường), cũ (xưa) thì viết thành củ (khoai, sắn) --=0
 
Upvote 0
Maika8008 đã viết:
Bạn cũng rất hài hước ấy chứ nhỉ. Sửa (chữa) thì viết là sữa (đặc có đường), cũ (xưa) thì viết thành củ (khoai, sắn) --=0
Nhấp chuột vào đây để mở rộng...
Hahaha...Anh đừng cười em nữa, tại em ít học, để em sửa lại ... hahaha
Bài đã được tự động gộp:

 
Upvote 0
hungdiep85 đã viết:
Dạ,
em đã áp dụng vào công việc cho ngày mai được luôn rồi à, hihihi..
nhưng em có sữa thủ công môt số trường hộp.

vì cứ 5 tổ màu được lặp lại, đôi lúc cần 6 tổ, 7 tổ, những tháng tết có ngày 20 tổ làm việc luôn, (phần màu 100% là đủ màu)

Anh có thể thêm giúp em phần Điền số tổ mong muốn
Ví dụ :
điền số 5, thì 5 tổ mới suất hiện lại màu củ. (file đang là 5 tổ)
điền số 6, thì 6 tổ mới suất hiện lại màu củ. (mong muốn)
điền số 7, thì 7 tổ mới suất hiện lại màu củ. (mong muốn)

Em cảm ơn anh nhiều lắm
Nhấp chuột vào đây để mở rộng...
Chỉnh lại dòng lệnh theo số tổ mới
Const SoTo& = 5
5 là số tổ
 
Upvote 0
HieuCD đã viết:
Chạy sub XYZ
Mã: 
Dim Res(), Dic As Object, Dic2 As Object, k&, d&

Sub XYZ()
  Dim sArr1(), sArr2()
  Dim ToDau&, sR1&, sR2&, n&, t&, fRow&, i&

  sArr1 = Range("B3:D82").Value:       sR1 = UBound(sArr1)
  sArr2 = Range("B83:D162").Value:     sR2 = UBound(sArr2)
  ReDim Res(1 To 25, 1 To 3)
  Set Dic = CreateObject("scripting.dictionary")
  Set Dic2 = CreateObject("scripting.dictionary")

  Randomize
  ToDau = Int(2 * Rnd)
  For n = 0 To 4
    For t = 1 To 5
      k = n * 5 + t
      d = 0
      If (k Mod 2) = ToDau Then
        Call CreateRes(sArr1, sR1)
      Else
        Call CreateRes(sArr2, sR2)
      End If
      If d = 100 Then
        fRow = n * 5 + 1
        For i = fRow To k - 1
          Dic2.Remove (Res(i, 2) & Res(i, 3))
          Dic2.Remove (Res(i, 3) & Res(i, 2))
        Next i
        n = n - 1: Exit For
      End If
    Next t
    Dic.RemoveAll
  Next n
  Range("I3").Resize(25, 3) = Res
End Sub

Private Sub CreateRes(ByRef sArr, ByVal sR&)
  Dim iR&, loai$, mau$, de$

  Do
    iR = Int(sR * Rnd + 1)
    loai = sArr(iR, 1): mau = sArr(iR, 2):     de = sArr(iR, 3)
    If loai <> Empty Then
      If Dic2.exists(mau & de) = False And Dic2.exists(de & mau) = False Then
        If Dic.exists(de) = False Then
          If Dic.exists(mau) = False Then
            Res(k, 1) = loai: Res(k, 2) = mau: Res(k, 3) = de
            Dic.Add mau, "": Dic.Add mau & "|", "": Dic.Add de, ""
            Dic2.Add mau & de, ""
            Dic2.Add de & mau, ""
            sArr(iR, 1) = Empty
            Exit Do
          Else
            d = d + 1
            If d = 100 Then Exit Do
          End If
        End If
      End If
    End If
  Loop Until k = 0
End Sub
Nhấp chuột vào đây để mở rộng...
Đâu đâu cũng thấy bác này. Bác tay to quá
 
Upvote 0
HieuCD đã viết:
Chỉnh lại dòng lệnh theo số tổ mới
Const SoTo& = 5
5 là số tổ
Nhấp chuột vào đây để mở rộng...
Dạ. Anh ơi
em gặp trường hợp tổ 1 và tổ 2 đang làm 01:00PM đến 03:00PM, 02:00PM tổ 7 và tổ 8 vào ca, thì bị lấy màu của tổ 1 và tổ 2 đang làm đến 03:00PM mới xong, Anh xem giúp em với.

Em cảm ơn anh
 

File đính kèm

  • Sắp xếp ngẫu nhiên có điều kiện (1) (6).xlsm
    48.9 KB · Đọc: 6
Upvote 0
hungdiep85 đã viết:
Dạ. Anh ơi
em gặp trường hợp tổ 1 và tổ 2 đang làm 01:00PM đến 03:00PM, 02:00PM tổ 7 và tổ 8 vào ca, thì bị lấy màu của tổ 1 và tổ 2 đang làm đến 03:00PM mới xong, Anh xem giúp em với.

Em cảm ơn anh
Nhấp chuột vào đây để mở rộng...
Code viết theo mỗi đợt có thời gian các tổ như nhau, không đan xen thời gian
Thời gian kiểu nầy phải viết mới từ đầu
 
Upvote 0
hungdiep85 đã viết:
Dạ. Anh ơi
em gặp trường hợp tổ 1 và tổ 2 đang làm 01:00PM đến 03:00PM, 02:00PM tổ 7 và tổ 8 vào ca, thì bị lấy màu của tổ 1 và tổ 2 đang làm đến 03:00PM mới xong, Anh xem giúp em với.

Em cảm ơn anh
Nhấp chuột vào đây để mở rộng...
Dữ liệu của bạn vô nghiệm
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

Toanke063
  • Question
Xin hỏi code vba chuyển 1 file pdf bất kì thành ảnh
Trả lời
1
Đọc
2
befaint
befaint
T
Xin trợ giúp code về dò tìm dữ liệu
Trả lời
1
Đọc
68
CHAOQUAY
C
thlpro
Truy Vấn Công thức từ Sheet này Qua Sheet Khác
Trả lời
7
Đọc
127
CHAOQUAY
C
S
Lý do công thức bị mờ tại ô Function
    • Cười
Trả lời
2
Đọc
46
sakurasumo
S
GPE-Trợ Lý
Đăng ký tham dự hội thảo tại Hà Nội: Power Query - Công cụ quản lý dữ liệu
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
5
Đọc
619
GPE-Trợ Lý
GPE-Trợ Lý
N
  • Question
Làm ơn viết giùm mình macro làm tròn giá trị ạ
    • Cười
Trả lời
14
Đọc
108
ptm0412
ptm0412
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
8 9 10
Trả lời
191
Đọc
10K
ongke0711
ongke0711
CNKyNguyen
Giảm dung lượng của file excel
    • Cảm ơn
    • Cười
    • Thích
Trả lời
2
Đọc
230
CNKyNguyen
CNKyNguyen
hunganh.nguyen
Xin giúp code tách dòng tổng thành những dòng chi tiết với giá trị là 1
Trả lời
9
Đọc
404
vostro 1500
vostro 1500
P
Sự cố về hàm SUMIF
Trả lời
8
Đọc
232
yeudoi
yeudoi
OverAC
Thông báo nội dung xấu và bài viết vi phạm nội quy.
19 20 21
Trả lời
416
Đọc
41K
vanle33
vanle33
S
Chuyển định dạng thời gian từ sa/ch sang AM/PM
Trả lời
2
Đọc
70
Silklynk
S
B
Sắp xếp lịch trực
5 6 7
Trả lời
130
Đọc
86K
TTVAN28
TTVAN28
N
Giúp em hàm Aggregate không chạy được trên Google sheet ah
Trả lời
4
Đọc
141
nguyenthieny
N
N
  • Question
VBA - copy các sheets unhide và dạng giá trị theo vùng xác định
Trả lời
2
Đọc
87
bebo021999
B
hoaithanh9480
Nhờ giúp đỡ về kiểm phiếu bầu
Trả lời
4
Đọc
103
hoaithanh9480
hoaithanh9480
B
Nhờ anh/chị giúp em tìm hàm cho công thức tính lương
Trả lời
2
Đọc
137
hoangtuaotrang_hp_vn
H
SA_DQ
Phẩu thuật Nụ cười lần 3 tại Huế.
    • Thích
    • Yêu thích
Trả lời
1
Đọc
100
HUONGHCKT
H
K
  • Question
Sử dụng Power Query để xử lý nhật ký chung nhiều nợ nhiều có
    • Cười
Trả lời
14
Đọc
297
viethung78
V
N
cộng các dữ liệu không trùng nhau
Trả lời
13
Đọc
241
DeTong
D
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom