Giúp hoàn thành bản excel

hanhkhachruoi · 26/12/10

Dear All

Mình là dân Technical nên biết về Excel chỉ có hạn chế nhất là phần VBA -0-/.

Mình chỉ đọc các tài liệu và các bài viết của các bạn để làm một số công dụng cơ bản phục vụ cho công việc nhưng chẳng bít gì cả.
Giờ gặp phải vấn đề khó khăn mà không biết phải làm thế nào.
Trong bản Excel mình gửi
Mình chỉ làm cho được một số đầu tiên trong cột này đánh giá được thôi còn muốn nó đánh giá trong các số còn lại thì pótay.Mình không hiểu sâu về những vòng lặp.Mình rất muốn làm cho nó chạy được nhưng không biết phải làm thế nào.

Mong các bạn sửa giúp mình.

Sau khi xem lại ;;;;;;;;;;;

mình có sửa lại được như file dưới

Ai quan tâm thì vô xem nhé và sửa dùm mình cho nó tìm kiếm các số ở cột A:A và đánh giá các điều kiện một cách tự động với )(&&@@

:

chọn dòng Ã rùi bấm Ctrl + Q nhé -0-/.

Ba Tê · 28/12/10

hanhkhachruoi đã viết:
Hix

Không ai giúp mình ah

Sau khi xem lại mình có sửa lại được như file dưới

Ai quan tâm thì vô xem nhé và sửa dùm mình cho nó tìm kiếm các số ở cột A:A và đánh giá các điều kiện một cách tự động với :

chọn dòng Ã rùi bấm Ctrl + Q nhé

Không ai dám trả lời vì chẳng hiểu bạn muốn gì, làm ra kết quả cho cột nào, dữ liệu lấy từ đâu? Cái bảng của Bạn chỉ mình Bạn hiểu vì không phải ai cũng đọc hiểu được bảng này.
Code của Bạn thì các cao thủ "ngâm cứu" chẳng biết sao, chứ người bình thường không ai có thời gian để tìm hiểu Bạn muốn làm gì khi code chạy.
Cố gắng giải thích càng rõ càng tốt nhé!
Hy vọng sau khi bạn giải thích rõ sẽ có cao thủ giúp sức, tôi (chắc cũng có nhiều người giống tôi) thì "bó tay"!

Thấy câu này đã muốn "hổng hiểu":

chọn dòng Ã rùi bấm Ctrl + Q nhé

hanhkhachruoi · 29/12/10

Sorry mọi người T.T /-*+/

Trong file mình gửi đó là dữ liệu của một sản phẩm trong công ty mình.

Sản phẩm đó có 13 lỗi mỗi lỗi được gán cho một mã là một số tự nhiên từ 0 - 13.

0 - Particle
1 - Contami
2 - S-Sratch
3 - 13 các lỗi khác nhau.

Mỗi lỗi lại được chia ra làm lỗi nhỏ được gán là số 0 ,lỗi lớn là 1.

>> 00 là lỗi Par loại nhỏ , 01 là lỗi Par loại lớn.
>> 10 là lỗi Contami loại nhỏ , 11 là lỗi contami loại lớn.
>> 20 là lỗi S-Sratch loại nhỏ , 21 là lỗi S-Sr loại lớn.
>> Tương tự như trên với các lỗi khác có mã 3->13.

Mỗi số slip :vd như 08S012356 là mã của một sản phẩm mà cần phải test.

Sản phẩm được đánh giá là OK hoặc NG (Not Good).

- Sản phẩm là NG nếu :
Trong sản phẩm có tìm thấy :
Lỗi 3-13 : cứ tìm thấy 1 lỗi trở lên
Lỗi Particle (00 & 01): tổng số count tìm thấy (00+01) > 20
Lỗi Contami (10 & 11) : lỗi 10 số count tìm thấy > 12 hoặc lỗi 11 số count > 3
Lỗi S-Scratch (20 & 21) : Lỗi 20 số count >40 hoặc lỗi 21 số count >24

- Sản phẩm được đánh giá là OK nếu :
Không tìm thấy lỗi 3 ->13.
Lỗi Particle (00 & 01): tổng số count tìm thấy (00+01) < 20
Lỗi Contami (10 & 11) : lỗi 10 số count tìm thấy < 12 hoặc lỗi 11 số count < 3
Lỗi S-Scratch (20 & 21) : Lỗi 20 số count <40 hoặc lỗi 21 số count <24
Và không tìm thấy lỗi nào trong sản phảm (nodata).

Các dữ liệu của mỗi sản phẩm được lấy từ máy đánh giá sản phẩm đó và chúng mình phải lọc xem disk nào OK và NG > lập báo cáo.

Từ trước mình copy data rùi dùng công thức của excel nhưng nó nặng, dài dòng và không chuyên nghiệp cho lắm.

Mình có lên diễn đàn giaiphapexcel là đọc các bài viết ở đây và mình cũng muốn dùng VBA để áp dụng vào công việc của mình.

Mình vừa sửa cho nó chạy tự động được rùi ( cho thêm vòn lặp For), nhưng cứ đến số slip cuối là nó bị đơ luôn và chưa biết giải quyết thế nào,và có số slip nó có 1 lỗi nó bỏ qua không đánh giá giống số slip no data.

Các bạn vào file mình gửi chạy Macrol Updata or phím tắt Ctrl + Q

Hix Hix +-+-+-+

Ai giúp mình với $-\\/.$

Các bạn xem file excel của mình thì:
Các số slip cần đánh giá là ở cột A
Loại lỗi ở cột D
Size của lỗi tương ứng là ỏ cột E
Kết quả đánh giá ở cột T

concogia · 29/12/10

hanhkhachruoi đã viết:
Các bạn xem file excel của mình thì:
Các số slip cần đánh giá là ở cột A
Loại lỗi ở cột D
Size của lỗi tương ứng là ỏ cột E
Kết quả đánh giá ở cột T

Hiểu được bài này mệt quá
Dữ liệu ở cột D gặp "thằng" : not exist file thì làm gì ???Bạn chạy thử code này "zồi kiểm cha" thử xem sao nhé

Mã:

Public Sub khohieuwa()
    Dim iDau, iCuoi, Cll, Vung, I, Tam, J, Wf, VungDem As Range, kK, Par, Con10, Con11, Sc20, Sc21, rCuoi
    Set Wf = Application.WorksheetFunction
    Set Vung = Range([b8], [b50000].End(xlUp))
    rCuoi = [b50000].End(xlUp).row
    kK = 1
    iCuoi = 8
        While iCuoi < rCuoi
        iDau = iCuoi
        iCuoi = Wf.Match(kK + 1, Range("b1:b" & rCuoi), 0)
            If iCuoi - iDau = 1 Then
                Set VungDem = Range("D" & iDau, "D" & iCuoi)
            Else
                Set VungDem = Range("D" & iDau, "D" & iCuoi - 1)
            End If
                If iCuoi - iDau = 1 And cells(iDau, 4) = "No Data" Then
                    cells(iDau, 4).Offset(, 16) = "OK"
                ElseIf Wf.Max(VungDem) > 2 Then
                    cells(iDau, 4).Offset(, 16) = "NG"
                Else
                        For Each Cll In VungDem
 
                            Tam = Cll & Cll.Offset(, 1)
                                If Tam = "00" Or Tam = "01" Then
                                    Par = Par + 1
                                ElseIf Tam = "10" Then
                                    Con10 = Con10 + 1
                                ElseIf Tam = "11" Then
                                    Con11 = Con11 + 1
                                ElseIf Tam = "20" Then
                                    Sc20 = Sc20 + 1
                                Else
                                    Sc21 = Sc21 + 1
                                End If
                        Next
                       If Par > 20 Or Con10 > 12 Or Con11 > 3 Or Sc20 > 40 Or Sc21 > 24 Then
                        cells(iDau, 4).Offset(, 16) = "NG"
                       Else
                        cells(iDau, 4).Offset(, 16) = "OK"
                       End If
                End If
            kK = kK + 1
          Par = 0: Con10 = 0: Con11 = 0: Sc20 = 0: Sc21 = 0
        Wend
End Sub

Thân

SA_DQ · 29/12/10

Mong các bạn sửa giúp mình.
Ai quan tâm thì vô xem nhé và sửa dùm mình cho nó tìm kiếm các số ở cột A:A và đánh giá các điều kiện một cách tự động với :

Mình sửa để macro của bạn chạy suốt hành trình mà bạn muốn đây.

Tuy nhiên macro của bạn chắc còn sửa lại nhiều lắm đó, cảm tính vậy thôi:

PHP:

Option Explicit
Sub GPE_Updata()
 On Error GoTo LoiCT
 Dim Ten As String
 Dim Rng As Range, Cell As Range
 Dim Xh As Double, Dem As Double, Count1 As Double, eRw As Long
Set Rng = Range([A1].End(xlDown), [a65500].End(xlUp).Offset(1))
Rng.Resize(2, 3).Font.ColorIndex = 2
eRw = [a65500].End(xlUp).row:           Application.ScreenUpdating = False
For Each Cell In Rng
    If Cell.row >= eRw Then Exit Sub
    If Not IsError(Cell) Then
        If Trim(Cell) <> "" Then
            Cell.Font.ColorIndex = 3
            Cell.Select:                            GoTo Start
7        End If
    End If
Next Cell
Start:
    Selection.End(xlDown).Select
    If Trim(Selection.Offset(-1)) = "" Then
        Range(Selection.Offset(-1), Selection.End(xlUp)).Select
    Else:
        Selection.End(xlDown).Select
        Range(Selection.Offset(-1), Selection.End(xlUp)).Select
    End If
    Selection.Offset(0, 3).Select
       ' Range(Selection.Offset(-1), Selection.End(xlUp)).Select'
    Ten = Selection.Address
    Range(Ten).Font.ColorIndex = 3
    For Each Cell In Range(Ten)
        If Not IsError(Cell) Then
            If Cell.Value >= 3 Then ' Exit For'
                Range("B11").Font.ColorIndex = 15
                Else: Range("B11").Font.ColorIndex = 0
            End If
        End If
    Next
 'Evaluate for Contami defect'
    For Each Cell In Range(Ten)
        If Not IsError(Cell) Then
            If Cell.Value = 1 Then
                 'Range("B8").Font.ColorIndex = 3 KQ >>OK'
                Cell.Offset(0, 15).Value = Cell.Value & Cell.Offset(0, 1).Value
            End If
        End If
    Next
    Range(Ten).Offset(0, 15).Select
    For Each Cell In Selection
        Dem = 0
        Xh = Cell.Value
        Dem = Application.CountIf(Selection, 10) + 1
        Count1 = Application.CountIf(Selection, 11) + 1
        If Count1 >= 3 Then
            Range("b12").Font.ColorIndex = 3 'KQ NG'
            Range("b13").Font.ColorIndex = 0
        ElseIf Count1 < 3 Then
            Range("b13").Font.ColorIndex = 4 'KQ >>OK'
            Range("b12").Font.ColorIndex = 0
 
            If Dem >= 12 Then
                Range("b14").Font.ColorIndex = 3 'KQ NG'
                Range("b15").Font.ColorIndex = 0
            ElseIf Dem < 12 Then
                Range("b15").Font.ColorIndex = 4 'KQ OK'
                Range("b14").Font.ColorIndex = 0
                Selection.Clear
            End If
        End If
    Next
'Evaluate for S-S defect'
    Range(Ten).Select
    For Each Cell In Range(Ten)
        If Not IsError(Cell) Then
            If Cell.Value = 2 Then
                Cell.Offset(0, 15).Value = Cell.Value & Cell.Offset(0, 1).Value
            End If
         End If
    Next
    Range(Ten).Offset(0, 15).Select
    For Each Cell In Selection
        Dem = 0
        Dem = Application.CountIf(Selection, 20) + 1
        Count1 = Application.CountIf(Selection, 21) + 1
        If Count1 >= 24 Then
            Range("b16").Font.ColorIndex = 3 'KQ NG'
            Range("b17").Font.ColorIndex = 0
        ElseIf Count1 < 24 Then
            Range("b17").Font.ColorIndex = 4 'KQ >>OK'
            Range("b16").Font.ColorIndex = 0
            If Dem >= 40 Then
                Range("b18").Font.ColorIndex = 3 'KQ NG'
                Range("b19").Font.ColorIndex = 0
            ElseIf Dem < 40 Then
                Range("b19").Font.ColorIndex = 4 'KQ OK'
                Range("b18").Font.ColorIndex = 0
                Selection.Clear
            End If
        End If
    Next
    Range(Ten).Select
    Dem = 0
    Dem = Application.Count(0) + 1
    If Dem >= 20 Then
        Range("b20").Font.ColorIndex = 3 ' KQ NG'
        Range("B21").Font.ColorIndex = 0
    Else
        Range("B21").Font.ColorIndex = 4  'KQ OK'
        Range("b20").Font.ColorIndex = 0
    End If
    GoTo 7
E:          MsgBox ("aaa")
Err_:                       Exit Sub
LoiCT:
    MsgBox Error$, , Cell.row:                 Resume Err_
End Sub

hanhkhachruoi · 30/12/10

Cảm ơn bạn đã tìm hiểu và sửa giúp mình.
"Not exit files" là file đó bị lỗi không có dữ liệu.
"Nodata" sản phẩm đó không có lỗi nào.
Mình thử chạy với code của bạn rùi nhưng không được nó báo lỗi "Run time error '1004' "
Thank you !

hanhkhachruoi · 30/12/10

HYen17 đã viết:

Mình sửa để macro của bạn chạy suốt hành trình mà bạn muốn đây.

Tuy nhiên macro của bạn chắc còn sửa lại nhiều lắm đó, cảm tính vậy thôi:

PHP:

Option Explicit
Sub GPE_Updata()
 On Error GoTo LoiCT
 Dim Ten As String
 Dim Rng As Range, Cell As Range
 Dim Xh As Double, Dem As Double, Count1 As Double, eRw As Long
Set Rng = Range([A1].End(xlDown), [a65500].End(xlUp).Offset(1))
Rng.Resize(2, 3).Font.ColorIndex = 2
eRw = [a65500].End(xlUp).row:           Application.ScreenUpdating = False
For Each Cell In Rng
    If Cell.row >= eRw Then Exit Sub
    If Not IsError(Cell) Then
        If Trim(Cell) <> "" Then
            Cell.Font.ColorIndex = 3
            Cell.Select:                            GoTo Start
7        End If
    End If
Next Cell
Start:
    Selection.End(xlDown).Select
    If Trim(Selection.Offset(-1)) = "" Then
        Range(Selection.Offset(-1), Selection.End(xlUp)).Select
    Else:
        Selection.End(xlDown).Select
        Range(Selection.Offset(-1), Selection.End(xlUp)).Select
    End If
    Selection.Offset(0, 3).Select
       ' Range(Selection.Offset(-1), Selection.End(xlUp)).Select'
    Ten = Selection.Address
    Range(Ten).Font.ColorIndex = 3
    For Each Cell In Range(Ten)
        If Not IsError(Cell) Then
            If Cell.Value >= 3 Then ' Exit For'
                Range("B11").Font.ColorIndex = 15
                Else: Range("B11").Font.ColorIndex = 0
            End If
        End If
    Next
 'Evaluate for Contami defect'
    For Each Cell In Range(Ten)
        If Not IsError(Cell) Then
            If Cell.Value = 1 Then
                 'Range("B8").Font.ColorIndex = 3 KQ >>OK'
                Cell.Offset(0, 15).Value = Cell.Value & Cell.Offset(0, 1).Value
            End If
        End If
    Next
    Range(Ten).Offset(0, 15).Select
    For Each Cell In Selection
        Dem = 0
        Xh = Cell.Value
        Dem = Application.CountIf(Selection, 10) + 1
        Count1 = Application.CountIf(Selection, 11) + 1
        If Count1 >= 3 Then
            Range("b12").Font.ColorIndex = 3 'KQ NG'
            Range("b13").Font.ColorIndex = 0
        ElseIf Count1 < 3 Then
            Range("b13").Font.ColorIndex = 4 'KQ >>OK'
            Range("b12").Font.ColorIndex = 0
 
            If Dem >= 12 Then
                Range("b14").Font.ColorIndex = 3 'KQ NG'
                Range("b15").Font.ColorIndex = 0
            ElseIf Dem < 12 Then
                Range("b15").Font.ColorIndex = 4 'KQ OK'
                Range("b14").Font.ColorIndex = 0
                Selection.Clear
            End If
        End If
    Next
'Evaluate for S-S defect'
    Range(Ten).Select
    For Each Cell In Range(Ten)
        If Not IsError(Cell) Then
            If Cell.Value = 2 Then
                Cell.Offset(0, 15).Value = Cell.Value & Cell.Offset(0, 1).Value
            End If
         End If
    Next
    Range(Ten).Offset(0, 15).Select
    For Each Cell In Selection
        Dem = 0
        Dem = Application.CountIf(Selection, 20) + 1
        Count1 = Application.CountIf(Selection, 21) + 1
        If Count1 >= 24 Then
            Range("b16").Font.ColorIndex = 3 'KQ NG'
            Range("b17").Font.ColorIndex = 0
        ElseIf Count1 < 24 Then
            Range("b17").Font.ColorIndex = 4 'KQ >>OK'
            Range("b16").Font.ColorIndex = 0
            If Dem >= 40 Then
                Range("b18").Font.ColorIndex = 3 'KQ NG'
                Range("b19").Font.ColorIndex = 0
            ElseIf Dem < 40 Then
                Range("b19").Font.ColorIndex = 4 'KQ OK'
                Range("b18").Font.ColorIndex = 0
                Selection.Clear
            End If
        End If
    Next
    Range(Ten).Select
    Dem = 0
    Dem = Application.Count(0) + 1
    If Dem >= 20 Then
        Range("b20").Font.ColorIndex = 3 ' KQ NG'
        Range("B21").Font.ColorIndex = 0
    Else
        Range("B21").Font.ColorIndex = 4  'KQ OK'
        Range("b20").Font.ColorIndex = 0
    End If
    GoTo 7
E:          MsgBox ("aaa")
Err_:                       Exit Sub
LoiCT:
    MsgBox Error$, , Cell.row:                 Resume Err_
End Sub

Cảm ơn ban nhé
VBA thật khó hiểu quá
Đọc code của bạn concogia mình chả hiểu được hết T.T .. Hix

concogia · 30/12/10

hanhkhachruoi đã viết:
Cảm ơn bạn đã tìm hiểu và sửa giúp mình.
"Not exit files" là file đó bị lỗi không có dữ liệu.
"Nodata" sản phẩm đó không có lỗi nào.
Mình thử chạy với code của bạn rùi nhưng không được nó báo lỗi "Run time error '1004' "
Thank you !

Mình hỏi bạn là gặp thằng "Not exist file" thì ra kết quả làm sao chứ đâu hỏi nghĩa của nó (hic), vậy cái đó bạn tự thêm vào code nhé
Còn bài nó đây, không gởi file vì hao tài quá
Bấm nút cho code chạy nhé
Thân

VBA thật khó hiểu quá
Đọc code của bạn concogia mình chả hiểu được hết T.T .. Hix

Híc,bài của bạn rắc rối quá, mình viết xong, đọc lại ....cũng "hổng" hiểu luôn thì bạn "hổng" hiểu là thường thôi

ChanhTQ@ · 30/12/10

Đọc câu văn của bạn giống như xem sách khi ngồi xe bò trên đường đê vậy. Tuỳ tiện quá

Mình cũng không hiểu bạn muốn gì nhưng rất muốn thử sức với bạn, nên tạm viết macro như sau:

PHP:

Option Explicit
Sub GPE_DanhGia()
 Dim Rng As Range, Cls As Range
 
 Sheets("D+").Select
 For Each Cls In Range([A1].End(xlDown), [A65500].End(xlUp))
    If Cls.Value <> "" Then
        With Cls.Offset(, 3)
            If IsNumeric(Cls.Offset(, 3).Value) Then
                If Cls.Offset(1).Value = "" Then
                    Set Rng = Range(Cls, Cls.End(xlDown))
                Else
                    Cls.Resize(, 4).Interior.ColorIndex = 40
                End If
            Else
                Cls.Resize(, 4).Interior.ColorIndex = IIf(.Value = "Not data", 35, 38)
            End If
        End With
    End If
 Next Cls
End Sub

Macro này đã làm được các việc sau:

(1) tìm ra các dòng có chứa "No data" tại cột 'D' (cũng như 'Not exist file') & tô màu fân biệt
(2) tìm ra dòng mã ờ cột 'A' mà ngay dưới nó là mã khác, (hai dòng 118 & 210)

Giờ bạn hãy cho biết cách xử lý với 2 dòng này trước đã.
Sau đó sẽ đến fần còn lại, là fần nhiều & lôi thôi nhất ta tính sau. Dân kỹ thuật bạn cũng biết rồi đó: Fải từ đơn giản đến fức tạp; từ cụ thể đến trừu tượng.

hanhkhachruoi · 30/12/10

ChanhTQ@ đã viết:
Mình cũng không hiểu bạn muốn gì nhưng rất muốn thử sức với bạn, nên tạm viết macro như sau:

PHP:

Option Explicit Sub GPE_DanhGia() Dim Rng As Range, Cls As Range Sheets("D+").Select For Each Cls In Range([A1].End(xlDown), [A65500].End(xlUp)) If Cls.Value <> "" Then With Cls.Offset(, 3) If IsNumeric(Cls.Offset(, 3).Value) Then If Cls.Offset(1).Value = "" Then Set Rng = Range(Cls, Cls.End(xlDown)) Else Cls.Resize(, 4).Interior.ColorIndex = 40 End If Else Cls.Resize(, 4).Interior.ColorIndex = IIf(.Value = "Not data", 35, 38) End If End With End If Next Cls End Sub

Macro này đã làm được các việc sau:

(1) tìm ra các dòng có chứa "No data" tại cột 'D' (cũng như 'Not exist file') & tô màu fân biệt
(2) tìm ra dòng mã ờ cột 'A' mà ngay dưới nó là mã khác, (hai dòng 118 & 210)

Giờ bạn hãy cho biết cách xử lý với 2 dòng này trước đã.
Sau đó sẽ đến fần còn lại, là fần nhiều & lôi thôi nhất ta tính sau. Dân kỹ thuật bạn cũng biết rồi đó: Fải từ đơn giản đến fức tạp; từ cụ thể đến trừu tượng.

Hi ^.^ bạn so sánh hay thật đấy . Mình dốt văn quá đó mà chắc tại ngày xưa hay đi chăn bò chăn trâu nên thế. ^^

(1) thì bạn cứ để nguyên như vậy không cần sửa đâu > OK.
(2) dòng mã ờ cột 'A' mà ngay dưới nó là mã khác, (hai dòng 118 & 210) thì cũng đưa ra đánh giá lỗi như các mã khác ( tại cái mã này có 1 lỗi nên có 1 dòng như vậy)
Còn đánh giá thì bạn xem giúp mình ở bài #3 nhé

Các bạn giỏi thật đấy ,cho mình hỏi học lập trình có khó không bạn,mình cũng muốn biết thêm về lĩnh vực này. Thank

SA_DQ · 30/12/10

hanhkhachruoi đã viết:
Hi ^.^ bạn so sánh hay thật đấy . Mình dốt văn quá đó mà chắc tại ngày xưa hay đi chăn bò chăn trâu nên thế. ^^

Không fải chê bạn dốt văn; mà là bạn viết việt văn giống với người gốc Việt {F2} vậy!

Còn đây là macro của bạn; Hiện đang dài. Bạn kiểm tra mọi trường hợp giả định trong file của mình;
Nếu toàn bộ OK thì mình sẽ tìm cách rút gọn thêm nữa.
(Bạn cũng cần rút kinh nghiệm khi đưa số liệu lên: Không nên đưa số liệu quá thực, nhưng số liệu fải tiêu biển hết thẩy mọi trường hợp có thể có. Cũng là vì lợi ích của bạn mình mới nêu vậy!)

PHP:

Option Explicit
Sub GPE_DanhGia()
 Dim Rng As Range, Cls As Range, fRng As Range, sRng As Range, Clls As Range
 Dim eRw As Long, WF As Object, DGia As Boolean
 Dim Jj As Byte, Err10 As Byte, Err11 As Byte, Err20 As Byte, Err21 As Byte
 
 Set WF = Application.WorksheetFunction:                    Sheets("D+").Select
 With Columns("A:f")
    .Font.ColorIndex = 0:                                   .Interior.ColorIndex = 2
 End With
 Set fRng = Range([A1].End(xlDown), [A65500].End(xlUp)).SpecialCells(xlCellTypeConstants, 3)
 For Each Cls In fRng
    If Cls.Value <> "" Then
        With Cls.Offset(, 3)
            If IsNumeric(Cls.Offset(, 3).Value) Then
                If Cls.Offset(1).Value = "" Then
                    eRw = Cls.End(xlDown).row
                    If eRw < 65500 Then
                        Set Rng = Range(Cls, Cls.End(xlDown).Offset(-1)).Offset(, 3)
                    Else
                        Set Rng = Range(Cls.Offset(, 3), Cls.Offset(, 3).End(xlDown))
                    End If
1                   For Jj = 3 To 13                        'Tim Loi 3->13:'
                        Set sRng = Rng.Find(Jj, , xlFormulas, xlWhole)
                        If Not sRng Is Nothing Then
                            sRng.Interior.ColorIndex = 3:   DGia = True
                            Cls.Font.ColorIndex = 3:        Exit For
                        End If
                    Next Jj
                    If DGia Then
                        DGia = False
2                   Else                'Tim Tong Cac Ma Loi =0:'
                        If WF.CountIf(Rng, 0) > 20 Then
                            Cls.Font.ColorIndex = 3
                            Rng.Interior.ColorIndex = 38
                        End If
3 'Tim Cac Ma Loi 1 & 2:'
                        Err10 = 0:                          Err21 = 0
                        Err11 = 0:                          Err20 = 0
                        For Each Clls In Rng
                            Select Case Clls.Value
                            Case 1
                                If Clls.Offset(, 1).Value = 0 Then
                                    Err10 = Err10 + 1
                                    If Err10 > 12 Then
                                        Cls.Font.ColorIndex = 3
                                        Clls.Interior.ColorIndex = 39
                                        Exit For
                                    End If
                                ElseIf Clls.Offset(, 1).Value = 1 Then
                                    Err11 = Err11 + 1
                                    If Err11 > 3 Then
                                        Cls.Font.ColorIndex = 3
                                        Clls.Offset(, 1).Interior.ColorIndex = 39
                                        Exit For
                                    End If
                                End If
                            Case 2
                                If Clls.Offset(, 1).Value = 0 Then
                                    Err20 = Err20 + 1
                                    If Err20 > 40 Then
                                        Cls.Font.ColorIndex = 3
                                        Clls.Interior.ColorIndex = 41
                                        Exit For
                                    End If
                                ElseIf Clls.Offset(, 1).Value = 1 Then
                                    Err21 = Err21 + 1
                                    Err11 = Err11 + 1
                                    If Err21 > 24 Then
                                        Cls.Font.ColorIndex = 3
                                        Clls.Offset(, 1).Interior.ColorIndex = 41
                                        Exit For
                                    End If
                                End If
                            End Select
                        Next Clls
                    End If
                Else
                    Cls.Resize(, 4).Interior.ColorIndex = IIf(Cls.Offset(, 3).Value < 3, 34, 39)
                End If
            Else
                Cls.Resize(, 4).Interior.ColorIndex = IIf(.Value = "Not data", 35, 38)
            End If
        End With
    End If
 Next Cls
End Sub

À còn vấn đề quan trọng muốn hỏi bạn;

Thay vì cột

D|E
2| 0
2| 1

Ta có thể chuyển thành

D|E
2| 2
2| 3

được không; Nếu được vậy chúng ta sẽ tiết kiệm được nhiều thời gian lắm đó!

hanhkhachruoi · 31/12/10

SA_DQ đã viết:
Không fải chê bạn dốt văn; mà là bạn viết việt văn giống với người gốc Việt {F2} vậy!

Còn đây là macro của bạn; Hiện đang dài. Bạn kiểm tra mọi trường hợp giả định trong file của mình;
Nếu toàn bộ OK thì mình sẽ tìm cách rút gọn thêm nữa.
(Bạn cũng cần rút kinh nghiệm khi đưa số liệu lên: Không nên đưa số liệu quá thực, nhưng số liệu fải tiêu biển hết thẩy mọi trường hợp có thể có. Cũng là vì lợi ích của bạn mình mới nêu vậy!)

À còn vấn đề quan trọng muốn hỏi bạn;

Thay vì cột

D|E
2| 0
2| 1
Ta có thể chuyển thành

D|E
2| 2
2| 3
được không; Nếu được vậy chúng ta sẽ tiết kiệm được nhiều thời gian lắm đó!

Bạn ơi mình thấy OK rùi đó bạn rút gọn và hoàn thành giúp mình.
Sau khi đánh giá nếu OK or NG bạn có thể cho tương ứng range Cls.offset(,16).value = OK or NG giúp mình được không.
Còn việc thay thế thì không được rùi bạn ah ,để mình nói một chút về công việc của mình :

Mình làm trong công ty chuyên sản xuất nền đĩa thủy tinh dành cho ổ cứng máy tình (Glass disk).Cái disk này độ giày 0.635 mm và bán kính 32.5mm.

Bộ phận mình sử dụng cái máy AOI (Automatic Optical Inspection) để đánh giá tự động từng cái disk này và dữ liệu về lỗi trên bề mặt của mỗi disk được máy tự động lưu thành một file rawdata ( mỗi disk một file).Mỗi một lỗi được cái máy này nó được qui định sẵn bằng các số tự nhiên như mình nói ở bài trên và ở cột E đó nếu số 0 thì là lỗi nhỏ (small) nếu là số 1 là lỗi lớn (lage) >> không đổi được.

Mình phải làm nhiều test cho chất lượng của disk và phải tổng hợp rất nhiều rawdata ( có ngày trên 1000 cái rawdata +-+-+-+

) coppy dữ liệu và đánh giá xem nó OK or NG lập số liệu và báo cáo -0-/.

( ngán nhất cái khoản này) hix.

Cảm ơn bạn đã giành thời gian ra giúp mình :-=

SA_DQ · 31/12/10

(1) Bạn ơi rút gọn và hoàn thành giúp mình.
Mình phải làm nhiều test cho chất lượng của disk và phải tổng hợp rất nhiều rawdata ( có ngày trên 1000 cái rawdata ) coppy dữ liệu và đánh giá xem nó OK or NG lập số liệu và báo cáo ( ngán nhất cái khoản này) hix.

(2) Sau khi đánh giá nếu OK or NG bạn có thể cho tương ứng range Cls.offset(,16).value = OK or NG giúp mình được không.
(3) Còn việc thay thế thì không được rùi bạn ah ,để mình nói một chút về công việc của mình :

(1) Mình đã tăng lên 1.472 records (nghĩa là ở cột 'D' có dữ liệu đến hàng 4.927) mà chỉ mất chưa đến giây, nên theo mình nghĩ chưa cần rút gọn nữa đâu bạn!

(2) Việc này bạn dư khả năng làm mà; Chổ nào có câu lệnh Cls.Font.ColorIndex=3 thì ta thêm dòng lệnh của bạn vô thôi; Muốn thay luôn cũng được, chỉ thêm vài fép thử cho chắc cú nữa thôi mà.
Đâm ra biếng nhác & ỉ lại từ lúc nào vậy? Khà, khà,. . .

Chúc vui nha!

Giúp hoàn thành bản excel

hanhkhachruoi

Thành viên mới

File đính kèm

Ba Tê

Cạo Rồi Khỏi Gội

hanhkhachruoi

Thành viên mới

File đính kèm

concogia

Gội rồi mới Cạo

SA_DQ

/(hông là gì!

hanhkhachruoi

Thành viên mới

hanhkhachruoi

Thành viên mới

concogia

Gội rồi mới Cạo

File đính kèm

ChanhTQ@

0901452không62

hanhkhachruoi

Thành viên mới

SA_DQ

/(hông là gì!

File đính kèm

hanhkhachruoi

Thành viên mới

SA_DQ

/(hông là gì!

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

Facebook

Group

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