Tìm số lượng công nhân tăng, giảm hàng tháng

[tam8678]

Mong các anh, em trên GPE xem và hướng dẩn giúp, tìm số lượng tăng giảm công nhân hàng tháng.
Cụ thể trong file đính kèm

 

[ndu96081631]

Viết sao cho NDU hiểu. Bạn cố gắng giúp tôi vậy thì hãy mường tượng như thế này NDU hởi :
- Mở file " Số công nhân tăng giảm lần 3 "
- Các cột từ B4 đến B...,C4 đến C..., D4 đến D...là khu vực nhập liệu, các số thẻ không nằm ngay ngắn và theo thứ tự từ thấp đến cao, không có khoảng trắng
- Tôi trình bày trong file trước là đã sắp xếp cho dể hiểu thôi
File đính kèm
( Số thẻ đến thời điểm này là 900 - không dùng hàm choose được phải không ?)

NDU ở phường nào ? Sao lại có thể uống cafe ? , bình thường thôi
Chúc mệt mà vui ( đừng có nổi quạo nhé)

Quả thật rắc rối ghê ---> Rắc rối nằm ở chổ sắp xếp chứ việc tìm kiếm thì quá dể rồi
Hic...
Cũng cố làm nhát nữa xem thế nào:

Sub Compare2List()
  Dim List1 As Range, List2 As Range, List3 As Range
  Dim Cll1 As Range, Cll2 As Range, Cll3 As Range, i As Long
  Set List1 = Range([B4], [B65536].End(xlUp))
  Set List2 = Range([C4], [C65536].End(xlUp))
  Set List3 = Range([D4], [D65536].End(xlUp))
  Range("E4:G60000").ClearContents
  With WorksheetFunction
    For Each Cll1 In List1
      If .CountIf(List2, Cll1) Then [E65536].End(xlUp)(2) = Cll1
    Next Cll1
    For Each Cll2 In List2
      If .CountIf(List1, Cll2) = 0 Then [F65536].End(xlUp)(2) = Cll2
    Next Cll2
    For Each Cll3 In List3
      If .CountIf(List1, Cll3) = 0 Then
        With Range("F65536").End(xlUp)
          .Offset(1, 0) = Cll3
          .Offset(1, 1) = Cll3
        End With
      Else
        Cells(i + 4, "G") = Cll3
        i = i + 1
      End If
    Next Cll3
  End With
End Sub

Phải công nhận là code mới nhất này CỦ CHUỐI nhất trong tất cả
Bạn kiểm tra lại xem nhé (không chắc là đúng)
(Tôi ở Trãng Dài ---> Hẹn uống cafe nếu có dịp... Ẹc.. Ẹc...)

 

[tam8678]

Trước tiên cám ơn bạn cái đã.
- Tôi ở gần trường NGÔ QUYỀN, bạn cho tôi số tel, liên hệ xuống BH uống cafe cho vui ( không biết NDU bao nhiêu tuổi ? Cho dễ xưng hô hởi " Tác giả Đại Ca"...câu này của bạn )
- Đã kiểm tra code rất kỷ, kết quả.......

Quả thật rắc rối ghê

- Bạn mà còn thấy như thế thì tôi như thế nào ?
- Bạn giải thích dùm tôi đọan code sau để tôi còn tiếp tục...

For Each Cll1 In List1
If .CountIf(List2, Cll1) Then [E65536].End(xlUp)(2) = Cll1
Next Cll1

và đọan này :

For Each Cll3 In List3
If .CountIf(List1, Cll3) = 0 Then
With Range("F65536").End(xlUp)
.Offset(1, 0) = Cll3
.Offset(1, 1) = Cll3
End With
Else
Cells(i + 4, "G") = Cll3
i = i + 1
End If
Next Cll3

Mong tin.

 

[ndu96081631]

Trước tiên cám ơn bạn cái đã.
- Tôi ở gần trường NGÔ QUYỀN, bạn cho tôi số tel, liên hệ xuống BH uống cafe cho vui

Để nhắn tin riêng hen!

( không biết NDU bao nhiêu tuổi ? Cho dễ xưng hô hởi " Tác giả Đại Ca"...câu này của bạn )

Birthday = 06/10/1966

- Bạn giải thích dùm tôi đọan code sau để tôi còn tiếp tục...

For Each Cll1 In List1
       If .CountIf(List2, Cll1) Then [E65536].End(xlUp)(2) = Cll1
     Next Cll1

- Duyệt các cell trong List1
- Nếu các cell này có tồn tại trong List2 thì "quăng" nó vào cột E, tại dưới cell cuối cùng có dử liệu

và đọan này :

For Each Cll3 In List3
      If .CountIf(List1, Cll3) = 0 Then
        With Range("F65536").End(xlUp)
          .Offset(1, 0) = Cll3
          .Offset(1, 1) = Cll3
        End With
      Else
        Cells(i + 4, "G") = Cll3
        i = i + 1
      End If
    Next Cll3

Mong tin.

- Duyệt các cell trong List3
- Nếu các cell này không tòn tại trong List 1 thì "quăng" nó vào cột F, ngay dưới cell cuối cùng có dử liệu... Đồng thời cũng điền luôn vào cột G (cùng dòng) ---> Ngược lại thì điền từ cell F4 trở xuống! --> (Cells(i + 4, "G") = Cll3)
Chổ màu đỏ này tôi lo lắng nhất, có thể nó sẽ "đè" vào dử liệu trước đó
Lý ra nên là
Range("G4:G60000").SpecialCells(4).Areas(1)(1) = Cll3 thì chắc ăn hơn ---> Ý nghĩa của code này là: Trong cột G, thấy chổ nào còn trống thì điền vào
Bạn kiểm tra thế nào rồi?

 

[tam8678]

To : NDU
Tôi đã kiểm tra rất kỷ code của bạn, kết quả là ...thất bại hoàn toàn ( Cười lên đi )
Tôi không hiểu ý của bạn viết trong code nhưng tôi đoán (có đoán ở trong đây ) lỗi chắc chắn nằm ở đây :

Chổ màu đỏ này tôi lo lắng nhất, có thể nó sẽ "đè" vào dử liệu trước đó

Vì vậy tôi mới nhờ bạn giải thích đoạn code là như thế.
Vậy thì tiếp tục hay là ................cười?
NDU nhắn tin theo số :0917150322 ( NDU = tuổi em út tôi )
Mong tin

 

[ndu96081631]

To : NDU
Tôi đã kiểm tra rất kỷ code của bạn, kết quả là ...thất bại hoàn toàn ( Cười lên đi )
Tôi không hiểu ý của bạn viết trong code nhưng tôi đoán (có đoán ở trong đây ) lỗi chắc chắn nằm ở đây :

Vì vậy tôi mới nhờ bạn giải thích đoạn code là như thế.
Vậy thì tiếp tục hay là ................cười?
NDU nhắn tin theo số :0917150322 ( NDU = tuổi em út tôi )
Mong tin

Ai chà! Vậy phải gọi bằng anh rồi
Anh đã thử thay đoạn màu đỏ thành cái mới chưa?
Thất bại là thất bại chổ nào?
Tôi nghĩ file anh đưa lên chỉ là giả lập thôi, đúng không? Vậy sao anh không đưa file thật lên? ---> Vì đôi khi chúng ta giả lập chưa tổng quát cũng ảnh hưởng rất nhiều đến code đấy
(nếu không tiện đưa file lên, anh có thể gữi vào mail này: ndu96081631@yahoo.com)

 

[tam8678]

Thất bại là thất bại chổ nào?

Nó đây chú NDU ơi .
Đính kèm fỉe ( 2 code trước và sau )
Nt cho anh đi.

 

[ndu96081631]

Nó đây chú NDU ơi .
Đính kèm fỉe ( 2 code trước và sau )
Nt cho anh đi.

Phùùùùùùùùùù ---> Chỉ có mỗi cái "SẮP XẾP" mà nó "nhọc" ghê!
Tạm thời làm cho anh theo phương án này:

Sub Compare2List()
  Dim List1 As Range, List2 As Range, List3 As Range
  Dim Cll1 As Range, Cll2 As Range, Cll3 As Range, i As Long
  Set List1 = Range([B4], [B65536].End(xlUp))
  Set List2 = Range([C4], [C65536].End(xlUp))
  Set List3 = Range([D4], [D65536].End(xlUp))
  Range("E4:G60000").ClearContents
  With WorksheetFunction
    For Each Cll1 In List1
      If .CountIf(List2, Cll1) Then [E65536].End(xlUp)(2) = Cll1
    Next Cll1
    For Each Cll2 In List2
      If .CountIf(List1, Cll2) = 0 Then [F65536].End(xlUp)(2) = Cll2
    Next Cll2
    For Each Cll3 In List3
      If .CountIf(List1, Cll3) = 0 Then
        With Range("F65536").End(xlUp)
          .Offset(1, 0) = Cll3
          .Offset(1, 1) = Cll3
        End With
      End If
    Next Cll3
    For Each Cll3 In List3
      If .CountIf(List1, Cll3) Then [G65536].End(xlUp)(2) = Cll3
    Next Cll3
  End With
End Sub

Chẳng hay tí nào nhưng anh cứ test thử xem ---> Có gì thông báo lại cho em biết nhé!
(Điều anh yêu cầu cũng khá lý thú, tạo công ăn việc làm cho em nên chắc chắn em rất hào hứng chứ chẳng "quạo" gì... Ẹc... Ẹc... ---> Có điều em thấy nó không hay, để em cố gắng tìm phương án khác, nếu được em post lên cho anh)

 

[tam8678]

To : Tác giả Đại Ca
Chậm trả lời do phải test code thật kỷ, kết quà => Chính xác
Chú xem file đính kèm sẽ thấy số liệu được sắp xếp rất dể thương, đúng yêu cầu.
Còn 1 yêu cầu nhỏ, ghi chú trong file.

Điều anh yêu cầu cũng khá lý thú

Kết quả thể hiện trong file thấy yêu cầu cũng bình thường, nhưng để đạt được thì oải quá phải không ?
Anh còn nhiều yêu cầu bình thường như thế.... Cười
Chúc thật vui
Trân trọng sự nhiệt tình của NDU

 

[ndu96081631]

Còn 1 yêu cầu nhỏ, ghi chú trong file.

Yêu cầu của anh là:

Có hàm nào tính dược số vừa tăng vừa giảm không NDU nhỉ, như ví dụ dưới là =4

Cái này dể thôi:

=SUMPRODUCT(1*(F4:F20=G4:G20))

hoặc:

=SUMPRODUCT(COUNTIF(F4:F20,G4:G20))

Tham chiếu F4:F20 và G4:G20 anh tự chỉnh lại cho phù hợp với dử liệu thật nhé