tại sao Code lại chạy lộn cột (1 người xem)

[DMQ]

Em có file tập làm code VBA, nhưng khi chạy lại nhảy lộn cột. Trong file dữ liệu ở cột"Tên hàng,số lượng,đvt,mã hàng" lại nhảy vào cột"số hàng,số hóa đơn,ngày hóa đơn,nội dung". Mong các AC giúp đỡ!!!! code đây ah:

Sub NH()Dim sArr(), dArr(), I As Long, J As Long, K As Long
Dim NGAYTT As Date, TKHQ As String, INVNO As String, BLNO As String, CONTNO As String, SOHD As String, NGAYHD As Date
Dim ND As String, ST As Currency, CHIHQ As Currency, TENH As String, SL As String, DVT As String, MH As String, NGAYNK As Date, KH As String
Dim tb As String
With Sheets("NH")
    NGAYTT = .[E4].Value: TKHQ = .[E6].Value: INVNO = .[E8].Value: BLNO = .[E10].Value: CONTNO = .[E12].Value: SOHD = .[E14]: NGAYHD = .[H4]
    ND = .[H6]: ST = .[H8]: CHIHQ = .[H10]: NGAYNK = .[H12]: KH = .[H14]
    sArr = .[E17:H26].Value
   If .[E4] = Empty Then tb = tb & " chua co NGAY THANH TOAN" & Chr(10)
   If .[E6] = Empty Then tb = tb & " chua co SO TKHQ" & Chr(10)
   If .[E8] = Empty Then tb = tb & " chua co SO INVOICE" & Chr(10)
   If .[E10] = Empty Then tb = tb & " chua co So BL" & Chr(10)
   If .[E12] = Empty Then tb = tb & " chua co So CONT" & Chr(10)
   If .[E14] = Empty Then tb = tb & " chua co So HOA DON" & Chr(10)
   If .[H4] = Empty Then tb = tb & " chua co NGAY HOA DON" & Chr(10)
   If .[H12] = Empty Then tb = tb & " chua co NGAY NHAP KHO" & Chr(10)
If Len(tb) > 0 Then
MsgBox Left(tb, Len(tb) - 1), 64, "K.THANH"
          Exit Sub  '-------------------------------
 End If
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 16)
For I = 1 To UBound(sArr, 1)
    If sArr(I, 1) <> Empty Then
        K = K + 1: dArr(K, 1) = NGAYTT
        dArr(K, 2) = TKHQ: dArr(K, 3) = INVNO: dArr(K, 4) = BLNO: dArr(K, 5) = CONTNO: dArr(K, 6) = SOHD: dArr(K, 7) = NGAYHD
        dArr(K, 8) = ND: dArr(K, 9) = ST: dArr(K, 10) = CHIHQ: dArr(K, 11) = NGAYNK: dArr(K, 12) = KH
        For J = 1 To 4
            dArr(K, J + 4) = sArr(I, J)
        Next J
    End If
Next I
If K Then
    Sheets("CTNH").[B60000].End(xlUp).Offset(1).Resize(K, 16) = dArr
    Sheets("NH").Range("E4,E6,E8,E10,E12,E14,H4,H6,H8,H10,H12,H14,D17:H26").ClearContents
    Sheets("NH").[E4].Select
    MsgBox "Da Luu xong", 64, "K.THANH"
Else
    MsgBox "Khong co du lieu", 64, "K.THANH"
End If
End Sub

 

[SA_DQ]

Bạn không cần gán dữ liệu thông qua mảng đâu.
Bạn có thể gán trực tiếp mà; Tốc độ thì vẫn nhanh hơn cách hiện giờ của bạn.

 

[DMQ]

Mong bạn chỉ rỏ dùm mình với. Trình độ VBA của mình kém lắm.

 

[cadafi]

Mong bạn chỉ rỏ dùm mình với. Trình độ VBA của mình kém lắm.

Trong đoạn code copy dữ liệu qua sheet CTNH, bạn sửa như sau

ReDim dArr(1 To UBound(sArr, 1), 1 To 17) '==> Sửa số 16 thành số 17
For I = 1 To UBound(sArr, 1)
If sArr(I, 1) <> Empty Then
K = K + 1: dArr(K, 1) = NGAYTT
dArr(K, 2) = TKHQ: dArr(K, 3) = INVNO: dArr(K, 4) = BLNO: dArr(K, 5) = CONTNO: dArr(K, 6) = SOHD: dArr(K, 7) = NGAYHD
dArr(K, 8) = ND: dArr(K, 9) = ST: dArr(K, 10) = CHIHQ: dArr(K, 11) = NGAYNK: dArr(K, 12) = KH
For J = 1 To 4
dArr(K, J + 13) = sArr(I, J) '==>Sửa J+4 thành J+13
Next J
End If
Next I

 

[DMQ]

Cám ơn Anh Cadifi nhiều, nhưng chỉ chỉnh chổ dArr(K, J + 12) = sArr(I, J) '==>Sửa J+4 thành J+12 thì mới đúng Anh Cadifi ơi. Ở trên vẫn giữ nguyên 16 Ah.

 

[DMQ]

Các AC chỉ cho em ở sheet"CTNH" cột "STT" có thể đánh số thứ tự tự động trong VBA được không Ah!!!