Code VBA lỗi (1 người xem)

thanhduytlv · 19/6/18

File lấy dữ liệu tử TXT sang Excel.

Sub UPDATE_MMS()
Sheets("MMS").Select

Columns("A:L").Select

Selection.ClearContents

Range("A1").Select

ChDir _

"D:\UserData\hoapham\Desktop\QUAN LY DAT HANG\TON KHO MMS HANG NGAY\TON MMS\TAM THOI\MMS-Thang 06 -2018"

Workbooks.OpenText Filename:= _

"D:\UserData\hoapham\Desktop\QUAN LY DAT HANG\TON KHO MMS HANG NGAY\TON MMS\TAM THOI\MMS-Thang 06 -2018\*.TXT" _

, Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _

Array(Array(0, 1), Array(10, 1), Array(50, 1), Array(63, 1), Array(83, 1), Array(103, 1), _

Array(115, 1), Array(138, 1), Array(161, 1), Array(173, 1), Array(183, 1)), _

TrailingMinusNumbers:=True

Cells.Select

Cells.EntireColumn.AutoFit

Range("A1").Select

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

Selection.Copy

Windows("DAT HANG MMS.xlsx").Activate

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

ActiveWorkbook.Save

End Sub

Nhờ các anh/chị giúp dùm vì sao dữ liệu lại bị 3 cột cuối như hình chụp

( Ngày Sale-Receipt-Order lại bị lỗi không như mẫu ????)
File và hình đính kèm.
Cho mình hỏi thêm hình bị lỗi gì và khắc phục nhanh vì dữ liệu khoảng 3k dong ko thể làm thủ công được.
Cám ơn rất 5.

HieuCD · 19/6/18

thanhduytlv đã viết:
File lấy dữ liệu tử TXT sang Excel.

Sub UPDATE_MMS()
Sheets("MMS").Select

Columns("A:L").Select

Selection.ClearContents

Range("A1").Select

ChDir _

"D:\UserData\hoapham\Desktop\QUAN LY DAT HANG\TON KHO MMS HANG NGAY\TON MMS\TAM THOI\MMS-Thang 06 -2018"

Workbooks.OpenText Filename:= _

"D:\UserData\hoapham\Desktop\QUAN LY DAT HANG\TON KHO MMS HANG NGAY\TON MMS\TAM THOI\MMS-Thang 06 -2018\*.TXT" _

, Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _

Array(Array(0, 1), Array(10, 1), Array(50, 1), Array(63, 1), Array(83, 1), Array(103, 1), _

Array(115, 1), Array(138, 1), Array(161, 1), Array(173, 1), Array(183, 1)), _

TrailingMinusNumbers:=True

Cells.Select

Cells.EntireColumn.AutoFit

Range("A1").Select

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

Selection.Copy

Windows("DAT HANG MMS.xlsx").Activate

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

ActiveWorkbook.Save

End Sub

Nhờ các anh/chị giúp dùm vì sao dữ liệu lại bị 3 cột cuối như hình chụp

( Ngày Sale-Receipt-Order lại bị lỗi không như mẫu ????)
File và hình đính kèm.
Cho mình hỏi thêm hình bị lỗi gì và khắc phục nhanh vì dữ liệu khoảng 3k dong ko thể làm thủ công được.
Cám ơn rất 5.View attachment 197711 View attachment 197711

Chạy thử code

Mã:

Sub UPDATE_MMS()
Dim PathStr As String
Sheets("MMS").Select
Columns("A:L").Clear
'PathStr = ThisWorkbook.Path
PathStr = "D:\UserData\hoapham\Desktop\QUAN LY DAT HANG\TON KHO MMS HANG NGAY\TON MMS\TAM THOI\MMS-Thang 06 -2018"
ChDir PathStr
Workbooks.OpenText Filename:=PathStr & "\*.TXT" _
, Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 1), Array(10, 1), Array(50, 1), Array(63, 1), Array(83, 1), Array(103, 1), _
Array(115, 1), Array(138, 1), Array(161, 1), Array(173, 1), Array(183, 1)), _
TrailingMinusNumbers:=True
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
ThisWorkbook.Activate
'Windows("DAT HANG MMS.xlsx").Activate
Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("H1") = "13/1/14"
If TypeName(Range("H1").Value) = "String" Then Call ChinhNgay
Range("H1").ClearContents

ActiveWorkbook.Save
End Sub

Private Sub ChinhNgay()
  Dim sArr(), S, tmp
  Dim i As Long, n As Long, j As Long
  sArr = Range("I1", Range("K65500").End(xlUp)).Value
  For i = 1 To UBound(sArr)
    If InStr(sArr(i, 1), "Sale") Then
      For n = i + 1 To UBound(sArr)
        If InStr(sArr(n, 1), "Date") Then
          i = n
          Exit For
        End If
        For j = 1 To 3
          tmp = sArr(n, j)
          If InStr(tmp, "/00") Then
            sArr(n, j) = Null
          Else
            If TypeName(tmp) = "String" Then
              S = Split(tmp, "/")
              sArr(n, j) = DateSerial(CLng(S(2)), CLng(S(1)), CLng(S(0)))
            Else
              sArr(n, j) = DateSerial(Year(tmp), Day(tmp), Month(tmp))
            End If
          End If
        Next j
      Next n
    End If
  Next i
  Range("I1:K1").Resize(UBound(sArr)) = sArr
End Sub

thanhduytlv · 19/6/18

HieuCD đã viết:

Chạy thử code

Mã:

Sub UPDATE_MMS()
Dim PathStr As String
Sheets("MMS").Select
Columns("A:L").Clear
'PathStr = ThisWorkbook.Path
PathStr = "D:\UserData\hoapham\Desktop\QUAN LY DAT HANG\TON KHO MMS HANG NGAY\TON MMS\TAM THOI\MMS-Thang 06 -2018"
ChDir PathStr
Workbooks.OpenText Filename:=PathStr & "\*.TXT" _
, Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 1), Array(10, 1), Array(50, 1), Array(63, 1), Array(83, 1), Array(103, 1), _
Array(115, 1), Array(138, 1), Array(161, 1), Array(173, 1), Array(183, 1)), _
TrailingMinusNumbers:=True
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
ThisWorkbook.Activate
'Windows("DAT HANG MMS.xlsx").Activate
Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("H1") = "13/1/14"
If TypeName(Range("H1").Value) = "String" Then Call ChinhNgay
Range("H1").ClearContents

ActiveWorkbook.Save
End Sub

Private Sub ChinhNgay()
  Dim sArr(), S, tmp
  Dim i As Long, n As Long, j As Long
  sArr = Range("I1", Range("K65500").End(xlUp)).Value
  For i = 1 To UBound(sArr)
    If InStr(sArr(i, 1), "Sale") Then
      For n = i + 1 To UBound(sArr)
        If InStr(sArr(n, 1), "Date") Then
          i = n
          Exit For
        End If
        For j = 1 To 3
          tmp = sArr(n, j)
          If InStr(tmp, "/00") Then
            sArr(n, j) = Null
          Else
            If TypeName(tmp) = "String" Then
              S = Split(tmp, "/")
              sArr(n, j) = DateSerial(CLng(S(2)), CLng(S(1)), CLng(S(0)))
            Else
              sArr(n, j) = DateSerial(Year(tmp), Day(tmp), Month(tmp))
            End If
          End If
        Next j
      Next n
    End If
  Next i
  Range("I1:K1").Resize(UBound(sArr)) = sArr
End Sub

Bài đã được tự động gộp: 19/6/18

Rất cám ơn bạn HiếuCD
Để tối nay mình thử liền.
Nếu có gì chưa ổn thì làm phiền bạn giúp dùm. Cám ơn rất nhiều.

Code VBA lỗi (1 người xem)

Người dùng đang xem chủ đề này

thanhduytlv

Thành viên mới

File đính kèm

HieuCD

Chuyên gia GPE

thanhduytlv

Thành viên mới

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

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

Đếm ngược thời gian