Tạo tính năng Copy vào Worksheet_Change mà không báo lỗi và vẫn chạy ra kết quả (1 người xem)

luanvien177 · 7/1/15

Chào cả nhà GPE đầu năm mới an lành hạnh phúc!

Trong file em gửi, mong các thành viên giúp đỡ về sự kiện Worksheet_Change ở Sheet "XUAT" làm sao khi em copy dữ liệu khoảng 8000 dòng vào mà không báo lỗi và vẫn chạy kết quả sang các cột bên cạnh chứ không cẩn phải enter từng dòng một.

Vì file là kết quả của em tự mày mò trên diễn đàn nên trình độ VBA của em không có căn bản. Em mong sự hướng dẫn nhiệt tình của các thành viên GPE.

http://up.4share.vn/f/5261656760646762/NXT2015.xlsm

Kiều Mạnh · 7/1/15

luanvien177 đã viết:
Chào cả nhà GPE đầu năm mới an lành hạnh phúc!

Trong file em gửi, mong các thành viên giúp đỡ về sự kiện Worksheet_Change ở Sheet "XUAT" làm sao khi em copy dữ liệu khoảng 8000 dòng vào mà không báo lỗi và vẫn chạy kết quả sang các cột bên cạnh chứ không cẩn phải enter từng dòng một.

Vì file là kết quả của em tự mày mò trên diễn đàn nên trình độ VBA của em không có căn bản. Em mong sự hướng dẫn nhiệt tình của các thành viên GPE.

http://up.4share.vn/f/5261656760646762/NXT2015.xlsm

xoá bớt dữ liệu đi úp lên GPe mình coi xem.. nếu được mình làm cho

NQ_AT · 7/1/15

luanvien177 đã viết:
Chào cả nhà GPE đầu năm mới an lành hạnh phúc!

Trong file em gửi, mong các thành viên giúp đỡ về sự kiện Worksheet_Change ở Sheet "XUAT" làm sao khi em copy dữ liệu khoảng 8000 dòng vào mà không báo lỗi và vẫn chạy kết quả sang các cột bên cạnh chứ không cẩn phải enter từng dòng một.

Vì file là kết quả của em tự mày mò trên diễn đàn nên trình độ VBA của em không có căn bản. Em mong sự hướng dẫn nhiệt tình của các thành viên GPE.

http://up.4share.vn/f/5261656760646762/NXT2015.xlsm

bạn thêm vào chổ này nhé

PHP:

 On Error Resume Next

If Not Intersect(Target, [H1].Resize(SoDg)) Is Nothing Then

    GPE

Còn copy vào mà nó update thì hình như phải dùng Worksheet_Selection , con worksheet_Change thì phải thao tác trực tiếp nó mới update.

Mình chỉ biết có vậy, cùng nhau ngâm cứu nha.

luanvien177 · 7/1/15

Option Explicit
Const SoDg As Integer = 9999
Dim Sh As Worksheet, Rng As Range
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sRng As Range: Dim j As Byte

If Not Intersect(Target, [H1].Resize(SoDg)) Is Nothing Then
GPE
Set sRng = Rng.Find(Target.Offset(, -4).Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
For j = 2 To 198
Target.Offset(, j - 1).Value = Target.Value * sRng.Offset(, j).Value * (1 + 0.01 * sRng.Offset(1, j).Value)
Next j
End If
ElseIf Not Intersect(Target, [C2].Resize(SoDg)) Is Nothing Then
GPE
Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then Target.Offset(, 1).Value = sRng.Offset(, 1).Value
End If
End Sub
Sub GPE()
Set Sh = ThisWorkbook.Worksheets("TABLE")
Set Rng = Sh.Range(Sh.[B5], Sh.[B65536].End(xlUp))
End Sub

Em gửi đoạn code VBA trong Sheet " XUAT" cho những ai ghé ngang Topic dễ đọc và cho em nhận xét nhanh hơn.
Em cám ơn nhiều.

Em mong các thành viên cho GPE giúp em cho tính năng Worksheet_change tự động cập nhật và chạy dữ liệu ra kết quả sang các cột bên cạnh, khi mình copy dữ liệu sang cột " Số lượng" .

Chân thành cám ơn. File em đã đính kèm trong link bên trên rồi đó mấy bạn.

luanvien177 · 7/1/15

https://www.mediafire.com/?i5sh7nt4on5og15

Mình gửi lại link Mediafire cho mấy bạn dễ download hơn.

Trong link mình đã cố gắng thu gọn lại dữ liệu hết mức rồi anh "kieu manh" ơi. Em mới thử nghiệm với khoảng 40 dòng thôi ah, chứ không phải 8000 dòng. Nên anh có thể down file về giúp giùm em sớm ạ.

Em chân thành cám ơn.

luanvien177 · 8/1/15

Em có tham khảo các bài viết trên diễn đàn, nhưng sao em không biết chỉnh code cho Worksheet_change không bị lỗi khi copy và chạy ra kết quả bình thường.
Mong mọi người giúp đỡ!!

Em thấy có một bài của thầy ndu96081631 cũng viết bằng tính năng Worksheet_change nhưng copy bình thường và ko báo lỗi. Nhưng em ko biết chỉnh code làm sao cho phù hợp với mình.
Tiện đây em xin gửi lại bài viết của ndu96081631 cho mọi người ghé ngang so sánh code của thầy và trong file của em

http://www.giaiphapexcel.com/forum/...ết-dùng-mã-vba-thay-thế-cho-hàm-vlookup/page4

NQ_AT · 8/1/15

luanvien177 đã viết:
Em có tham khảo các bài viết trên diễn đàn, nhưng sao em không biết chỉnh code cho Worksheet_change không bị lỗi khi copy và chạy ra kết quả bình thường.
Mong mọi người giúp đỡ!!

Em thấy có một bài của thầy ndu96081631 cũng viết bằng tính năng Worksheet_change nhưng copy bình thường và ko báo lỗi. Nhưng em ko biết chỉnh code làm sao cho phù hợp với mình.
Tiện đây em xin gửi lại bài viết của ndu96081631 cho mọi người ghé ngang so sánh code của thầy và trong file của em

http://www.giaiphapexcel.com/forum/...ết-dùng-mã-vba-thay-thế-cho-hàm-vlookup/page4

Mình đã trả lời cho bạn rồi còn gì nữa.
Thêm cái này code

PHP:

On Error Resume Next

Cụ thể vào chổ này:

PHP:

 On Error Resume Next

If Not Intersect(Target, [H1].Resize(SoDg)) Is Nothing Then

    GPE

Khi copy dữ liệu vào, khi phát sinh lỗi thì code sẽ reset lại, cứ thế copy thoải mái.
Không được thì bạn thử thêm cách này nhé.

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
'Dim ........
On Error Resume Next
Application.EnableEvents = False


' Code cua ban

Application.EnableEvents = True
End Sub

luanvien177 · 8/1/15

Thanks a NQ_AT, em đã thử cách của anh hướng dẫn và thành công về việc copy ko bị lỗi. Nhưng còn vấn đề để nó chạy ra kết quả số liệu thì nó chưa làm được anh ơi.

Như vậy, em cũng phải enter cho từng dòng một để nó chạy kết quả, mà dữ liệu em sẽ copy vào khoảng 8000 dòng, nên em hỏi có cách khắc phục này luôn ko anh???

NQ_AT · 8/1/15

luanvien177 đã viết:
Thanks a NQ_AT, em đã thử cách của anh hướng dẫn và thành công về việc copy ko bị lỗi. Nhưng còn vấn đề để nó chạy ra kết quả số liệu thì nó chưa làm được anh ơi.

Như vậy, em cũng phải enter cho từng dòng một để nó chạy kết quả, mà dữ liệu em sẽ copy vào khoảng 8000 dòng, nên em hỏi có cách khắc phục này luôn ko anh???

Cái này mình botay, biết chút ít VBA thôi, phải nhờ các anh Cao thủ GPE trợ giúp vậy.

dhn46 · 9/1/15

Bạn dùng sự kiện Worksheet_Change(ByVal Target As Range) thì sẽ gặp lỗi khi copy paste là điều tất nhiên thôi.

Nếu bạn viết được Code này thì bạn có thể chuyển nó thành dạng Sub và gán vào nút lệnh để tính toán. 1 lần bấm chắc cũng không mất quá nhiêu thời gian.

ndu96081631 · 9/1/15

dhn46 đã viết:
Bạn dùng sự kiện Worksheet_Change(ByVal Target As Range) thì sẽ gặp lỗi khi copy paste là điều tất nhiên thôi.

Không hẳn vậy đâu!
Nên nhớ rằng Target không phải luôn là 1 Cell. Vậy nên để làm việc với sự kiện Worksheet_Change khi Target = nhiều cells, ta sẽ dùng For... Next để giải quyết
Vụ này tôi làm hoài trên GPE rồi, cú pháp chung mà tôi hay dùng là vầy:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim [B][COLOR=#0000cd]cel[/COLOR][/B] As Range, rng As Range
  If Not Intersect(Range("Gì gì đó"), Target) Is Nothing Then
    Set rng = Intersect(Range("Gì gì đó"), Target)
    For Each [B][COLOR=#0000cd]cel[/COLOR][/B] In rng
      ''Code xử lý tại đây, tham chiếu đến biến [B][COLOR=#0000cd]cel[/COLOR][/B] (chứ không tham chiếu đến Target)
    Next
  End If
End Sub

luanvien177 · 9/1/15

Thầy ndu96081631 ơi, thầy chỉnh code phía trên giùm em được ko??
Em đã thử cú pháp thầy hướng dẫn rồi, nhưng em làm nó ko chạy được thầy ơi!!
Em không có căn bản, chỉ là em lượm lặt code VBA tham khảo trên diễn đàn GPE rồi chế lại theo ý em thôi. Nên gặp sự cố em ko biết chỉnh cho bài bản.

Thầy chỉnh lại code trong sheet" XUAT" giùm em nha, em đã cố hết sức ở bài hướng dẫn của thầy nhưng em thực sự ko làm nỗi.
Mong thầy giúp đỡ em. Chân thành cám ơn

luanvien177 · 10/1/15

Em đã thử viết theo cú pháp của thầy như sau, nhưng em ko làm nó chạy được thầy ơi. Em cố gắng viết lại như sau:

Option Explicit
Const SoDg As Integer = 9999
Dim Sh As Worksheet, rng As Range
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, rng As Range
Dim sRng As Range: Dim j As Byte

If Not Intersect(Range([H1:H65536]), Target) Is Nothing Then
Set rng = Intersect(Range([H1:H65536]), Target)
For Each cel In rng
If Not Intersect(cel, [H1].Resize(SoDg)) Is Nothing Then
GPE
Set sRng = rng.Find(cel.Offset(, -4).Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
For j = 2 To 208
cel.Offset(, j - 1).Value = cel.Value * sRng.Offset(, j).Value * (1 + 0.01 * sRng.Offset(1, j).Value)
Next j

ElseIf Not Intersect(cel, [C2].Resize(SoDg)) Is Nothing Then
GPE
Set sRng = rng.Find(cel.Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then cel.Offset(, 1).Value = sRng.Offset(, 1).Value
End If
Next

End If

End Sub

Sub GPE()
Set Sh = ThisWorkbook.Worksheets("TABLE")
Set rng = Sh.Range(Sh.[B5], Sh.[B65536].End(xlUp))
End Sub

Mong thầy chỉ giúp em sai chỗ nào và sửa code giùm em với. Mong sự hướng dẫn của thầy và các thành viên trên GPE !!
Chân thành cám ơn mọi người.

luanvien177 · 10/1/15

Các member GPE, ai ghé ngang Topic giúp em chỉnh code phía trên với.
Mong các anh chị hỗ trợ để em hoàn thành file Nhập - Xuất - Tồn phía trên. Đó là sản phẩm đầu tay của em trong suốt 02 tháng cày diễn đàn GPE này. keke

Chân thành cám ơn mấy anh chị

NQ_AT · 11/1/15

luanvien177 đã viết:
Các member GPE, ai ghé ngang Topic giúp em chỉnh code phía trên với.
Mong các anh chị hỗ trợ để em hoàn thành file Nhập - Xuất - Tồn phía trên. Đó là sản phẩm đầu tay của em trong suốt 02 tháng cày diễn đàn GPE này. keke

Chân thành cám ơn mấy anh chị

Bạn tham khảo bài này xem sao nha, bài này dùng Array, mình thấy sẽ tự update khi worksheet_change

http://www.giaiphapexcel.com/forum/...Xin-viết-dùng-mã-vba-thay-thế-cho-hàm-vlookup

luanvien177 · 11/1/15

Anh NQ_AT, cho e hỏi cái bài anh gửi dùng Array thì áp dụng về code của file em khi nhân hệ số tiêu hao như thế nào vậy anh, thật ra em chưa rành VBA, chỉ là học lóm trên GPE thôi, nên anh chỉ giúp em.

Cụ thể là đoạn code này viết lại sao anh:

Set sRng = Rng.Find(Target.Offset(, -4).Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
For j = 2 To 208
Target.Offset(, j - 1).Value = Target.Value * sRng.Offset(, j).Value * (1 + 0.01 * sRng.Offset(1, j).Value)
Next j
End If

Chân thành cám ơn anh giúp đỡ !!

NQ_AT · 11/1/15

luanvien177 đã viết:
Anh NQ_AT, cho e hỏi cái bài anh gửi dùng Array thì áp dụng về code của file em khi nhân hệ số tiêu hao như thế nào vậy anh, thật ra em chưa rành VBA, chỉ là học lóm trên GPE thôi, nên anh chỉ giúp em.

Cụ thể là đoạn code này viết lại sao anh:

Set sRng = Rng.Find(Target.Offset(, -4).Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
For j = 2 To 208
Target.Offset(, j - 1).Value = Target.Value * sRng.Offset(, j).Value * (1 + 0.01 * sRng.Offset(1, j).Value)
Next j
End If

Chân thành cám ơn anh giúp đỡ !!

hihih, cái đó botay, mình cũng đang mò kim đấy bể nè, đâu hơn gì bạn, chỉ biết nó lấy thông tin như Vlookup, còn kết hợp với tính toán thì thua.

luanvien177 · 13/1/15

Mong các thành viên GPE ghé ngang Topic chỉnh code giùm mình !!!

Chân thành cám ơn !!

luanvien177 · 14/1/15

Chân thành mong sự giúp đỡ của các thành viên GPE hỗ trợ giùm mình để mình và anh NQ_AT có thể học hỏi nhiều hơn về code trong tính năng Worksheet_Change!!

luanvien177 · 28/1/15

Thầy Ndu ơi, giúp em chỉnh code cho ra kết quả giùm em nha thầy.
Em đã cố gắng chỉnh theo cú pháp của thầy, nhưng vẫn ko chạy được thầy ah. Với lại, phần nhân hệ số vào cho mỗi cel mình tham chiếu vào thì mình làm sao hả thầy??

Em xin gửi phần code em đã chỉnh lại 1 lần nữa, thầy Ndu96081631 xem giúp em:

Option Explicit
Const SoDg As Integer = 9999
Dim Sh As Worksheet, Rng As Range

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, rng As Range
Dim sRng As Range: Dim j As Byte

If Not Intersect(Range([H1:H65536]), Target) Is Nothing Then
Set rng = Intersect(Range([H1:H65536]), Target)
For Each cel In rng
If Not Intersect(cel, [H1].Resize(SoDg)) Is Nothing Then
GPE
Set sRng = rng.Find(cel.Offset(, -4).Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
For j = 2 To 208
cel.Offset(, j - 1).Value = cel.Value * sRng.Offset(, j).Value * (1 + 0.01 * sRng.Offset(1, j).Value)
Next j

ElseIf Not Intersect(cel, [C2].Resize(SoDg)) Is Nothing Then
GPE
Set sRng = rng.Find(cel.Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then cel.Offset(, 1).Value = sRng.Offset(, 1).Value
End If
Next

End If

End Sub

Sub GPE()
Set Sh = ThisWorkbook.Worksheets("TABLE")
Set rng = Sh.Range(Sh.[B5], Sh.[B65536].End(xlUp))
End Sub

Tạo tính năng Copy vào Worksheet_Change mà không báo lỗi và vẫn chạy ra kết quả (1 người xem)

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

https://www.vienpham.com

I don't program, I beat code into submission!!!

Thành viên chính thức

https://www.vienpham.com

https://www.vienpham.com

https://www.vienpham.com

Thành viên chính thức

https://www.vienpham.com

Thành viên chính thức

Hướng tới tương lai

Huyền thoại GPE

https://www.vienpham.com

https://www.vienpham.com

https://www.vienpham.com

Thành viên chính thức

https://www.vienpham.com

Thành viên chính thức

https://www.vienpham.com

https://www.vienpham.com

https://www.vienpham.com

Thời gian đếm ngược.