Wordsheet chạy không dừng

Liên hệ QC

tphan19

Thành viên mới
Tham gia
6/7/09
Bài viết
9
Được thích
0
Các pro xem giùm em code trong worksheet change sai chỗ nào mà nó chạy mãi không dừng. (File gửi kèm)
EM cảm ơn nhiều.
 

File đính kèm

  • event worksheet.doc
    14 KB · Đọc: 97
  • Hoi dap exel.xlsx
    914.9 KB · Đọc: 110
Có ở bài#1 trong file word
@tphan19
Nên up file excel code (xlsm) lên , còn cho vào file word làm chi
Thực ra ý chính là đưa code đã sửa lên. Nhiều khi người hướng dẫn chuẩn nhưng người kia lại sửa không chuẩn mà chỉ kêu "không chạy". Khi buộc phải gửi code đã sửa lên thì mới lòi cái thao tác sai ra.
 
Upvote 0
Thực ra ý chính là đưa code đã sửa lên. Nhiều khi người hướng dẫn chuẩn nhưng người kia lại sửa không chuẩn mà chỉ kêu "không chạy". Khi buộc phải gửi code đã sửa lên thì mới lòi cái thao tác sai ra.

Da code đây ạ

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim MaTP As String
Dim lastRowDM As Integer, RowCount As Integer, i As Integer, j As Integer
Dim DataArr As Variant

'Kiem tra xem có phai thay doi tren cot C hay khong
If Target.Column = 3 Then

'Lay thong so dau vao
MaTP = Target.Value
lastRowDM = Sheets("DM_NVL").Range("D" & Rows.Count).End(xlUp).Row
RowCount = WorksheetFunction.CountIf(Sheets("DM_NVL").Range("D21:D" & lastRowDM), MaTP)

'Kiem tra dieu kien co so lieu
If RowCount > 0 Then

'Chen so dong trong de dien dinh muc tuong ung
Sheets("XUAT_VT").Range(Target.Row + 1 & ":" & Target.Row + RowCount - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Application.EnableEvents = False
'Dien so lieu
DataArr = Sheets("DM_NVL").Range("D21:J" & lastRowDM).Value
For i = LBound(DataArr, 1) To UBound(DataArr, 1)
If DataArr(i, 1) = MaTP Then
Sheets("XUAT_VT").Range("C" & Target.Row + j).Value = MaTP
Sheets("XUAT_VT").Range("E" & Target.Row + j).Value = DataArr(i, 2)
Sheets("XUAT_VT").Range("F" & Target.Row + j).Value = DataArr(i, 3)
Sheets("XUAT_VT").Range("G" & Target.Row + j).Value = DataArr(i, 4)
Sheets("XUAT_VT").Range("J" & Target.Row + j).Value = DataArr(i, 7)
j = j + 1
Application.EnableEvents = True
End If
Next
End If
End If
End Sub
 
Upvote 0
Da code đây ạ

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim MaTP As String
Dim lastRowDM As Integer, RowCount As Integer, i As Integer, j As Integer
Dim DataArr As Variant

'Kiem tra xem có phai thay doi tren cot C hay khong
If Target.Column = 3 Then

'Lay thong so dau vao
MaTP = Target.Value
lastRowDM = Sheets("DM_NVL").Range("D" & Rows.Count).End(xlUp).Row
RowCount = WorksheetFunction.CountIf(Sheets("DM_NVL").Range("D21:D" & lastRowDM), MaTP)

'Kiem tra dieu kien co so lieu
If RowCount > 0 Then

'Chen so dong trong de dien dinh muc tuong ung
Sheets("XUAT_VT").Range(Target.Row + 1 & ":" & Target.Row + RowCount - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Application.EnableEvents = False
'Dien so lieu
DataArr = Sheets("DM_NVL").Range("D21:J" & lastRowDM).Value
For i = LBound(DataArr, 1) To UBound(DataArr, 1)
If DataArr(i, 1) = MaTP Then
Sheets("XUAT_VT").Range("C" & Target.Row + j).Value = MaTP
Sheets("XUAT_VT").Range("E" & Target.Row + j).Value = DataArr(i, 2)
Sheets("XUAT_VT").Range("F" & Target.Row + j).Value = DataArr(i, 3)
Sheets("XUAT_VT").Range("G" & Target.Row + j).Value = DataArr(i, 4)
Sheets("XUAT_VT").Range("J" & Target.Row + j).Value = DataArr(i, 7)
j = j + 1
Application.EnableEvents = True
End If
Next
End If
End If
End Sub
Bạn nói xem bạn muốn gì.Ở code này.Hihi.
 
Upvote 0
Bạn nói xem bạn muốn gì.Ở code này.Hihi.

Có bảng ứng với 3 sheet, DM_VT (Định mức Vật tư) NK_Nhap(Sổ kho Thành phẩm), XUAT_VT (Sổ kho xuất vật tư)

Trong bảng Định mức vật tư, mỗi mã hàng có khoảng 7-9 nguyên vật liệu. Đưa hết các nguyên vật liệu từ Bảng Định mức Vật tư vào bảng Sổ Kho Vật tư ứng với mỗi mã hàng trong bảng SỔ KHO THÀNH PHẨM. Ví dụ Mã hàng VNXG có 8 dòng vật tư, phải đưa hết 8 dòng đó sang bảng sổ kho Vật Tư gồm các cột E, F, G,J của bảng Định Mức.
Rồi cột số lượng của cột "Kg/Hop " trong Định mức Nhân Với cột "So_Luong" trong bảng SỔ KHO THÀNH PHẨM ứng với từng mã hàng.
Mục đích là muốn tính số lượng vật tư cần thiết cho mỗi mã sản phẩm.
Ví dụ ngày hôm nay sản xuất mã hàng VNXG (SO LUONG 550 CAI) thì cần mỗi loại vật tư là bao nhiêu.
 

File đính kèm

  • Hoi dap exel.xlsx
    943 KB · Đọc: 76
Upvote 0
Biết ngay mà. Khi gửi code đã sửa xong thì lòi ra ngay là không làm đúng như hướng dẫn.
Hướng dẫn
Loại code sự kiện này, sau phần khai báo biến, khi vào chương trình chính,tắt sự kiện:

Application.EnableEvents = False
...
Cụ thể chèn chỗ nào anh? em ko hiểu lắm
...
1 cái ngay chỗ đầu.
Tức ngay sau phần khai báo biến. Thực ra ở đâu cũng được nhưng phải trước dòng
Mã:
Sheets("XUAT_VT").Range(Target.Row + 1 & ":" & Target.Row + RowCount - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
vì dòng này sẽ gây ra sự kiện Worksheet_Change nên code vào lại Worksheet_Change, rồi sau khi thực hiện dòng trên thì lại vào Worksheet_Change, cứ như thế tới ngày tận thế.

Nhìn Application.EnableEvents = False sau dòng trên là đủ biết không làm đúng như người ta hướng dẫn.
 
Upvote 0
Có bảng ứng với 3 sheet, DM_VT (Định mức Vật tư) NK_Nhap(Sổ kho Thành phẩm), XUAT_VT (Sổ kho xuất vật tư)

Trong bảng Định mức vật tư, mỗi mã hàng có khoảng 7-9 nguyên vật liệu. Đưa hết các nguyên vật liệu từ Bảng Định mức Vật tư vào bảng Sổ Kho Vật tư ứng với mỗi mã hàng trong bảng SỔ KHO THÀNH PHẨM. Ví dụ Mã hàng VNXG có 8 dòng vật tư, phải đưa hết 8 dòng đó sang bảng sổ kho Vật Tư gồm các cột E, F, G,J của bảng Định Mức.
Rồi cột số lượng của cột "Kg/Hop " trong Định mức Nhân Với cột "So_Luong" trong bảng SỔ KHO THÀNH PHẨM ứng với từng mã hàng.
Mục đích là muốn tính số lượng vật tư cần thiết cho mỗi mã sản phẩm.
Ví dụ ngày hôm nay sản xuất mã hàng VNXG (SO LUONG 550 CAI) thì cần mỗi loại vật tư là bao nhiêu.
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim MaTP As String
Dim lastRowDM As Integer, RowCount As Integer, i As Integer, j As Integer
Dim DataArr As Variant

'Kiem tra xem có phai thay doi tren cot C hay khong
If Target.Column = 3 Then
   Application.EnableEvents = False
'Lay thong so dau vao
MaTP = Target.Value
lastRowDM = Sheets("DM_NVL").Range("D" & Rows.Count).End(xlUp).Row
RowCount = WorksheetFunction.CountIf(Sheets("DM_NVL").Range("D21:D" & lastRowDM), MaTP)

'Kiem tra dieu kien co so lieu
If RowCount > 0 Then

'Chen so dong trong de dien dinh muc tuong ung
Sheets("XUAT_VT").Range(Target.Row + 1 & ":" & Target.Row + RowCount - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove


'Dien so lieu
DataArr = Sheets("DM_NVL").Range("D21:J" & lastRowDM).Value
For i = LBound(DataArr, 1) To UBound(DataArr, 1)
If DataArr(i, 1) = MaTP Then
Sheets("XUAT_VT").Range("C" & Target.Row + j).Value = MaTP
Sheets("XUAT_VT").Range("E" & Target.Row + j).Value = DataArr(i, 2)
Sheets("XUAT_VT").Range("F" & Target.Row + j).Value = DataArr(i, 3)
Sheets("XUAT_VT").Range("G" & Target.Row + j).Value = DataArr(i, 4)
Sheets("XUAT_VT").Range("J" & Target.Row + j).Value = DataArr(i, 7)
j = j + 1

End If
Next
End If
Application.EnableEvents = True
End If
End Sub
Bạn xem.Nhưng cái code của bạn có 1 vấn đề là rất vớ vẩn.
 
Upvote 0
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim MaTP As String
Dim lastRowDM As Integer, RowCount As Integer, i As Integer, j As Integer
Dim DataArr As Variant

'Kiem tra xem có phai thay doi tren cot C hay khong
If Target.Column = 3 Then
   Application.EnableEvents = False
'Lay thong so dau vao
MaTP = Target.Value
lastRowDM = Sheets("DM_NVL").Range("D" & Rows.Count).End(xlUp).Row
RowCount = WorksheetFunction.CountIf(Sheets("DM_NVL").Range("D21:D" & lastRowDM), MaTP)

'Kiem tra dieu kien co so lieu
If RowCount > 0 Then

'Chen so dong trong de dien dinh muc tuong ung
Sheets("XUAT_VT").Range(Target.Row + 1 & ":" & Target.Row + RowCount - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove


'Dien so lieu
DataArr = Sheets("DM_NVL").Range("D21:J" & lastRowDM).Value
For i = LBound(DataArr, 1) To UBound(DataArr, 1)
If DataArr(i, 1) = MaTP Then
Sheets("XUAT_VT").Range("C" & Target.Row + j).Value = MaTP
Sheets("XUAT_VT").Range("E" & Target.Row + j).Value = DataArr(i, 2)
Sheets("XUAT_VT").Range("F" & Target.Row + j).Value = DataArr(i, 3)
Sheets("XUAT_VT").Range("G" & Target.Row + j).Value = DataArr(i, 4)
Sheets("XUAT_VT").Range("J" & Target.Row + j).Value = DataArr(i, 7)
j = j + 1

End If
Next
End If
Application.EnableEvents = True
End If
End Sub
Bạn xem.Nhưng cái code của bạn có 1 vấn đề là rất vớ vẩn.
Dạ cam ơn nhiều. Cao thủ chỉ giúp em ạ.
Bài đã được tự động gộp:

Mã:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim MaTP As String
Dim lastRowDM As Integer, RowCount As Integer, i As Integer, j As Integer
Dim DataArr As Variant

'Kiem tra xem có phai thay doi tren cot C hay khong
If Target.Column = 3 Then
   Application.EnableEvents = False
'Lay thong so dau vao
MaTP = Target.Value
lastRowDM = Sheets("DM_NVL").Range("D" & Rows.Count).End(xlUp).Row
RowCount = WorksheetFunction.CountIf(Sheets("DM_NVL").Range("D21:D" & lastRowDM), MaTP)

'Kiem tra dieu kien co so lieu
If RowCount > 0 Then

'Chen so dong trong de dien dinh muc tuong ung
Sheets("XUAT_VT").Range(Target.Row + 1 & ":" & Target.Row + RowCount - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove


'Dien so lieu
DataArr = Sheets("DM_NVL").Range("D21:J" & lastRowDM).Value
For i = LBound(DataArr, 1) To UBound(DataArr, 1)
If DataArr(i, 1) = MaTP Then
Sheets("XUAT_VT").Range("C" & Target.Row + j).Value = MaTP
Sheets("XUAT_VT").Range("E" & Target.Row + j).Value = DataArr(i, 2)
Sheets("XUAT_VT").Range("F" & Target.Row + j).Value = DataArr(i, 3)
Sheets("XUAT_VT").Range("G" & Target.Row + j).Value = DataArr(i, 4)
Sheets("XUAT_VT").Range("J" & Target.Row + j).Value = DataArr(i, 7)
j = j + 1

End If
Next
End If
Application.EnableEvents = True
End If
End Sub
Bạn xem.Nhưng cái code của bạn có 1 vấn đề là rất vớ vẩn.
ANh có hướng xử lý nào tốt hơn không chỉ giùm em với
 
Lần chỉnh sửa cuối:
Upvote 0
Dạ cam ơn nhiều. Cao thủ chỉ giúp em ạ.
Bài đã được tự động gộp:


ANh có hướng xử lý nào tốt hơn không chỉ giùm em với
Code này hay bị lỗi là khi copy lần 2, 3 mã hàng cùng lúc vào là nó báo lỗi và code không chạy nữa. Tắt file mở lại thì mới nhập được. Mỗi lần nhận có 1 mã, mỗi ngày cty sx 50 mã chắc chết. Có pro nào giúp em giải quyết vấn đề này em cảm ơn.
 
Upvote 0
Code này hay bị lỗi là khi copy lần 2, 3 mã hàng cùng lúc vào là nó báo lỗi và code không chạy nữa. Tắt file mở lại thì mới nhập được. Mỗi lần nhận có 1 mã, mỗi ngày cty sx 50 mã chắc chết. Có pro nào giúp em giải quyết vấn đề này em cảm ơn.
Vậy bạn nên nhập mã ở 1 ô thôi.Rồi gán nó vào bảng tính.Sự kiện nên để 1 ô thôi.Không nhất thiết phải để cả cột C.
 
Upvote 0
Code này hay bị lỗi là khi copy lần 2, 3 mã hàng cùng lúc vào là nó báo lỗi và code không chạy nữa. Tắt file mở lại thì mới nhập được. Mỗi lần nhận có 1 mã, mỗi ngày cty sx 50 mã chắc chết. Có pro nào giúp em giải quyết vấn đề này em cảm ơn.
Nên kiểm tra xem Target là 1 cell hay nhiều cells
Nhiều Cells thì phải xử lý theo kiểu nhiều Cells thì mới được
Kiểm tra thông qua thuộc tính
Target.Cells.Count
 
Upvote 0
Các bạn cho mình hỏi ké với, mình cũng viết Private Sub Worksheet_Change để copy dữ liệu từ thư viện, nhưng khi Xóa 1 dòng thì sau đó code không chạy nữa mà phải đóng file mở lại mới chạy tiếp, Có cách nào xử lý không vậy ạ?
Mã:
Public Function getSpeed(doIt As Boolean)
    Application.ScreenUpdating = Not (doIt)
    Application.EnableEvents = Not (doIt)
    Application.Calculation = IIf(doIt, xlCalculationManual, xlCalculationAutomatic)
End Function
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    getSpeed (True)
    Dim var As Double
    If Target.Count > 1 Then Exit Sub
    
    On Error GoTo ErrHandler:
    If Not Sh Is Sheet3 And Not Application.Intersect(Target, Sh.Range("A:A")) Is Nothing Then
      
        var = Application.Match(Target.Value, Sheet3.Columns(1), 0)
        If Not IsError(var) Then
            i = MsgBox("Copy Cong thuc tu Thu vien khong?", vbInformation + vbYesNo, "Nhap cong thuc")
            If (i = vbYes) Then
                Target(1, 2).Formula = "=Product(Lib1!" & Worksheets("Lib1").Cells(var, 2).Address & "," & "Lib1!" & Worksheets("Lib1").Cells(var, 3).Address & ")"
                Target(1, 3).Formula = "=Lib1!" & Worksheets("Lib1").Cells(var, 4).Address
                Target(1, 5).Formula = "=" & Target(1, 2).Address(False, False) & "*(1+" & Target(1, 3).Address(False, False) & ")+" & Target(1, 4).Address(False, False)
                
                With Target(1, 6).Validation
                 .Delete 'delete previous validation
                 .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=Offset('Lib1'!Q" & var & ",0,0,1,3)"
                End With
                Target(0, 1).EntireRow.Copy
                Target.Select
                Target.PasteSpecial xlFormats
                Application.CutCopyMode = False
            Else: GoTo ErrHandler:
            End If
        Else: GoTo ErrHandler:
        End If
    End If
ErrHandler:
getSpeed (False)
End Sub
 
Upvote 0
Web KT
Back
Top Bottom