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:code trong worksheet change sai chỗ nào mà nó chạy mãi không dừng.
Cụ thể chèn chỗ nào anh? em ko hiểu lắmLoạ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
Và trước khi exit thêm dòng:
Application.EnableEvents = True
Da, cam ơn anh nhiều, em làm rồi mà nó ko chạy. Bỏ 2 câu lệnh đó ra thì chạy không ngừng.1 cái ngay chỗ đầu.Là không chạy sự kiện khi chạy code
1 cái cuối.Mở chạy sự kiện.
Thì copy cái code đó lên GPE chứ ai mà đoán mò được? Tốt nhất là copy code mà bạn đã sửa rồi mà "nó ko chạy"Da, cam ơn anh nhiều, em làm rồi mà nó ko chạy. Bỏ 2 câu lệnh đó ra thì chạy không ngừng.
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.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.
Bạn nói xem bạn muốn gì.Ở code này.Hihi.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" & 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.
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òngLoạ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.
Sheets("XUAT_VT").Range(Target.Row + 1 & ":" & Target.Row + RowCount - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
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.
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
Dạ cam ơn nhiều. Cao thủ chỉ giúp em ạ.Bạn xem.Nhưng cái code của bạn có 1 vấn đề là rất vớ vẩn.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
ANh có hướng xử lý nào tốt hơn không chỉ giùm em vớiBạn xem.Nhưng cái code của bạn có 1 vấn đề là rất vớ vẩn.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
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.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
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.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 cellsCode 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.
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
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2