Xin kiểm tra giúp đoạn code (1 người xem)

[phuoclocvl]

Xin Chào Các Anh Em GPE,
Em có viết đoạn code như sau nhưng nó không chạy, do mới tập viết mong là các anh chị em đừng ném đá.
các anh chị có thể xem file đính kèm cho dễ à.


Cảm ơn ạ.

Dim out, wht, kq As Worksheet
Public Sub Get_PuPl()
Set out = Worksheets("OUTPUT")
Set wht = Worksheets("WHT")
Set kr = Worksheets("KQ")
Worksheets("KQ").Range("A1:T1").AutoFilter
With Worksheets("KQ")
.Cells(1, 1) = "WKC" '2
.Cells(1, 2) = "MO_SUB" '3
.Cells(1, 3) = "MO_REFNO" '4
.Cells(1, 4) = "FITEM" '6
.Cells(1, 5) = "WHT-BODY" '
.Cells(1, 6) = "PU-PL"
.Cells(1, 7) = "QTY_SCAN" '8
.Cells(1, 8) = "WHT(PCS)"
.Cells(1, 9) = "QTY-PCS"
.Cells(1, 10) = "DATE" '19
.Cells(1, 11) = "WORK-CENTER" '14
.Cells(1, 12) = "WORK-CENTER-DATE-PU"
End With
k = 1
n = Worksheets("WHT").Range("A2:F" & Range("A" & Rows.Count).End(xlUp).Row)
m = Worksheets("OUTPUT").Range("A2:T" & Range("A" & Rows.Count).End(xlUp).Row)
'ReDim kq(1 To UBound(n, 1), 1 To 12)
For i = 1 To UBound(n) 'wht
For h = 1 To UBound(m) 'output
If out.Cells(h, 2) = "WP410" Or out.Cells(h, 2) = "WP460" Or out.Cells(h, 2) = "WP480" Then
If Not IsNull(out.Cells(h, 14)) And out.Cells(h, 6) = wht.Cells(i, 1) Then
k = k + 1
kq(k, 1) = out.Cells(h, 2)
kq(k, 2) = out.Cells(h, 3)
kq(k, 3) = out.Cells(h, 4)
kq(k, 4) = out.Cells(h, 6)
kq(k, 5) = wht.Cells(i, 2)
kq(k, 6) = wht.Cells(i, 6)
kq(k, 7) = out.Cells(h, 8)
kq(k, 8) = wht.Cells(h, 3)
kq(k, 9) = kq(k, 7) * kq(k, 8)
kq(k, 10) = out.Cells(h, 19)
kq(k, 11) = out.Cells(h, 14)
kq(k, 12) = kq(k, 6) & kq(k, 11) & kq(k, 10)
End If
End If
Next h
Next i
kr.Range("A2").Resize(k, 11).Value = kq
End Sub

 

[giaiphap]

Xin Chào Các Anh Em GPE,
Em có viết đoạn code như sau nhưng nó không chạy, do mới tập viết mong là các anh chị em đừng ném đá.
các anh chị có thể xem file đính kèm cho dễ à.

Tôi lười sửa code của người khác quá, thôi thì bạn nêu mục đích làm gì để anh em viết code lại sẽ nhanh hơn.

 

[phuoclocvl]

Tôi lười sửa code của người khác quá, thôi thì bạn nêu mục đích làm gì để anh em viết code lại sẽ nhanh hơn.

Dạ là vầy ạ.
Em có 3 sheet
1. WHT
2. OUTPUT
3.KQ
1. Xét cột 2 sheet OUTPUT nếu là WP410. WP460. WP480.

2. Điều kiện 2 là cột 14 của sheet OUTPUT ko rỗng và cột số 6 của sheet OUT bằng với cột 1 Của sheet WHT .
3. Thì sheet KQ lần lượt là
Cột 1 : cột 2 của sheet OUTPUT
Cột 2 : cột 3 của sheet OUTPUT
Cột 3 : cột 4 của sheet OUTPUT
Cột 4 : cột 6 của sheet OUTPUT
Cột 5 : cột 2 của sheet WHT
Cột 6 : cột 6 của sheet WHT
Cột 7 : cột 8 của sheet OUTPUT
Cột 8 : cột 3 của sheet WHT
Cột 9 : cột 7 sheet KQ * Cột 8 KQ
Cột 10 : cột 19 của sheet OUTPUT
Cột 11 : cột 14 của sheet OUTPUT
Cột 12 : Nối cột 6, cột 11 và cột 10 của Sheet KQ lại.

Dạ cảm ơn.

 

[giaiphap]

Bạn sử dụng thử code này xem sao, bạn tự kiểm tra nhé.

Public Sub Get_PuPl()
    Dim Arr, dArr, sArr, i As Integer, h As Integer, k As Integer
    Sheet1.Cells.ClearContents
    Sheet1.Range("A1").Resize(, 12) = Array("WKC", "MO_SUB", "MO_REFNO", "FITEM", "WHT-BODY", "PU-PL", "QTY_SCAN", "WHT(PCS)", "QTY-PCS", "DATE", "WORK-CENTER", "WORK-CENTER-DATE-PU")
    sArr = Sheet4.Range("A2:F" & Sheet4.Range("A65000").End(xlUp).Row).Value
    dArr = Sheet7.Range("A2:T" & Sheet7.Range("A65000").End(xlUp).Row).Value
    ReDim Arr(1 To UBound(sArr, 1), 1 To 12)
        For i = LBound(sArr, 1) To UBound(sArr, 1)
        For h = LBound(dArr, 1) To UBound(dArr, 1)
            If dArr(h, 2) = "WP410" Or dArr(h, 2) = "WP460" Or dArr(h, 2) = "WP480" Then
                If Not IsNull(dArr(h, 14)) And dArr(h, 6) = sArr(i, 1) Then
                    k = k + 1
                    Arr(k, 1) = dArr(h, 2)
                    Arr(k, 2) = dArr(h, 3)
                    Arr(k, 3) = dArr(h, 4)
                    Arr(k, 4) = dArr(h, 6)
                    Arr(k, 5) = sArr(i, 2)
                    Arr(k, 6) = sArr(i, 6)
                    Arr(k, 7) = dArr(h, 8)
                    Arr(k, 8) = sArr(i, 3)
                    Arr(k, 9) = Arr(k, 7) * Arr(k, 8)
                    Arr(k, 10) = dArr(h, 19)
                    Arr(k, 11) = dArr(h, 14)
                    Arr(k, 12) = Arr(k, 6) & Arr(k, 11) & Arr(k, 10)
                End If
            End If
        Next h
        Next i
        Sheet1.Range("A2").Resize(k, 11).Value = Arr
End Sub