Code VBA lỗi

Liên hệ QC
T

thanhduytlv

Thành viên mới
Tham gia
4/7/10
Bài viết
35
Được thích
4
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.20180619_113352.jpg20180619_113352.jpg
 

File đính kèm

  • TON KHO.txt
    327.7 KB · Đọc: 4
  • TON KHO.xlsx
    76.7 KB · Đọc: 3
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 197711View attachment 197711
Nhấp chuột vào đây để mở rộng...
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
 
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
Nhấp chuột vào đây để mở rộng...
Bài đã được tự động gộp:

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.
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

P
  • Question
Xin code gán mở theo tài khoản/profie đăng nhập bằng gmail sẵn trên trình duyệt
Trả lời
2
Đọc
146
phantu93
P
V
công thức của nó là gì ạ. mong mọi người giúp
Trả lời
1
Đọc
54
CHAOQUAY
C
son0611excel
  • Question
VBA tra cứu hình theo điều kiện
Trả lời
13
Đọc
280
ongke0711
ongke0711
Salem999999999
Lọc dữ liệu có điều kiện
2
Trả lời
25
Đọc
601
tle2003
T
vuongnlks
Lấy dữ liệu 1 cột cụ thể theo ngày từ nhiều file CSV ứng với mã tương ứng trong cột MA CO PHIEU
Trả lời
1
Đọc
108
BuiQuangThuan
B
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom