Có ai bị lỗi như sau không nhỉ?

Liên hệ QC

levanduyet

Hãy để gió cuốn đi.
Thành viên danh dự
Tham gia
30/5/06
Bài viết
1,798
Được thích
4,706
Giới tính
Nam
Tôi viết một thủ tục như sau:

Mã:
Sub MakeQTFabricList()

    Dim wsReport As Worksheet, wsData As Worksheet, wsQT As Worksheet
    Dim rngSource As Range, rngRange As Range
    Dim sMaterialNo As String, sMaterialDes As String, sQtDes As String
    Dim iQuiltedThickness As Integer
    Dim i As Long, j As Long, k As Long, iCase As Integer
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    Set rngSource = Application.Range("tb_Sample")

    Set wsData = Application.ThisWorkbook.Worksheets("FABRIC_LIST")
    Set wsReport = Application.ThisWorkbook.Worksheets("REPORT")
    Set wsQT = Application.ThisWorkbook.Worksheets("QT")
    'Clear all at the Report worksheet
    wsReport.Cells.ClearFormats
    wsReport.Cells.ClearContents
    'The first row of the Fabric_List worksheet
    i = 4
    sMaterialNo = wsData.Cells(i, 1)
    'The first row of the Report worksheet
    j = 3
    'Initial the iCase
    iCase = 1
    rngSource.Copy
    Do While Len(Trim(sMaterialNo)) > 0
        Select Case iCase
        Case 1    'i.e Quilted ticking with pu thickness 10mm D12, no fibre
            With wsReport.Range("A" & j)
                .PasteSpecial xlPasteFormulas
                .Offset(0, 0) = sMaterialNo
                .Offset(1, 3) = 10
            End With
        Case 2    'i.e Quilted ticking with pu thickness 10mm D20, fibre 300 grm
            With wsReport.Range("A" & j)
                .PasteSpecial xlPasteFormulas
                .Offset(0, 0) = sMaterialNo
                .Offset(1, 3) = 10
                .Offset(2, 3) = "Y"
            End With
        Case 3    'i.e Quilted ticking with pu thickness 15mm D20, no fibre
            With wsReport.Range("A" & j)
                .PasteSpecial xlPasteFormulas
                .Offset(0, 0) = sMaterialNo
                .Offset(1, 3) = 15
            End With
        Case 4    'i.e Quilted ticking with pu thickness 20mm D20, no fibre
            With wsReport.Range("A" & j)
                .PasteSpecial xlPasteFormulas
                .Offset(0, 0) = sMaterialNo
                .Offset(1, 3) = 20
            End With
        Case 5    'i.e Quilted ticking with pu thickness 20mm D20, fibre 300 grm
            With wsReport.Range("A" & j)
                .PasteSpecial xlPasteFormulas
                .Offset(0, 0) = sMaterialNo
                .Offset(1, 3) = 20
                .Offset(2, 3) = "Y"
            End With
        Case 6    'i.e Quilted ticking with pu thickness 25mm D20, no fibre
            With wsReport.Range("A" & j)
                .PasteSpecial xlPasteFormulas
                .Offset(0, 0) = sMaterialNo
                .Offset(1, 3) = 25
            End With
        Case 7    'i.e Quilted ticking with pu thickness 25mm D20, fibre 300 grm
            With wsReport.Range("A" & j)
                .PasteSpecial xlPasteFormulas
                .Offset(0, 0) = sMaterialNo
                .Offset(1, 3) = 25
                .Offset(2, 3) = "Y"
            End With
        Case 8    'i.e Quilted ticking with pu thickness 30mm D20, no fibre
            With wsReport.Range("A" & j)
                .PasteSpecial xlPasteFormulas
                .Offset(0, 0) = sMaterialNo
                .Offset(1, 3) = 30
            End With
        Case 9    'i.e Quilted ticking with pu thickness 30mm D20, fibre 300 grm
            With wsReport.Range("A" & j)
                .PasteSpecial xlPasteFormulas
                .Offset(0, 0) = sMaterialNo
                .Offset(1, 3) = 30
                .Offset(2, 3) = "Y"
            End With
        Case 10    'i.e Quilted ticking with pu thickness 35mm D20, fibre 300 grm
            With wsReport.Range("A" & j)
                .PasteSpecial xlPasteFormulas
                .Offset(0, 0) = sMaterialNo
                .Offset(1, 3) = 35
                .Offset(2, 3) = "Y"
            End With
        Case 11    'i.e Quilted ticking with pu thickness 35mm D20, fibre 500 grm
            With wsReport.Range("A" & j)
                .PasteSpecial xlPasteFormulas
                .Offset(0, 0) = sMaterialNo
                .Offset(1, 3) = 35
                .Offset(3, 3) = "Y"
            End With
        End Select

        If iCase = 11 Then
            iCase = 1
            i = i + 1
            sMaterialNo = wsData.Cells(i, 1)
        Else
            iCase = iCase + 1
        End If
        j = j + 16

    Loop
    'Refresh data before continuous
    wsReport.Calculate
    'Clear the data at QT worksheet
    Set rngRange = Application.Range("tb_QT_Del")
    rngRange.ClearFormats
    rngRange.ClearContents
    k = 3
    'Then create the Quilted Fabric table
    For i = 1 To j
        sMaterialNo = wsReport.Cells(i, 1)
        sMaterialDes = wsReport.Cells(i, 3)
        sQtDes = wsReport.Cells(i, 5)
        If Len(Trim(sMaterialNo)) > 0 Then
            With wsQT
                .Cells(k, 1) = k - 2
                .Cells(k, 2) = sQtDes
                .Cells(k, 3) = sMaterialNo
                .Cells(k, 4) = sMaterialDes
            End With
            k = k + 1
        End If
    Next i

    'Name the table
    Call DefineName("QT", "tb_QT", 3, 2, k - 1, 5)

    'Release the memory
    Set rngSource = Nothing
    Set wsData = Nothing
    Set wsReport = Nothing
    Set wsQT = Nothing
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    'Inform the user
    MsgBoxUni VNI("Baïn ñaõ taïo thaønh coâng" & vbCrLf & _
                  "Danh saùch vaûi ñaõ may chaàn"), vbOKOnly, VNI("Thoâng baùo")
    

End Sub
Nhưng sau khi thực hiện màn hình tôi bị như sau:
Loi_Excel.gif


Lê Văn Duyệt
 
Web KT

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

Back
Top Bottom