Xin xử lý code: Copy và Paste vào hàng nhập liệu!

[Tuan.DNa]

10000 dòng cũng là rất nhiều rồi mà.
Nếu bạn muốn vùng B4:B10000 ấy "động" thì có thể dùng 1 biến để tìm dòng cuối (ví dụ : Lr=Ws.cells(Rows.count,"B")..End(xlup)).Row và thay cái số 10000 ấy = các biến dòng cuối ấy ( Range("B4"B" Lr) ) xem được không? Hoặc bạn đặt cái vùng có dữ liệu B4:b1000 thành 1 namerange xem sao?
Công thức namerange động thì chắc bạn cũng biết rồi.

Mình dùng hàm dòng cuối. Cảm ơn bạn đã hướng dẫn nha.

 

[Tuan.DNa]

Sáng ra, làm đại 1 quả, hy vọng đúng ý.
Thay code cũ bằng code này:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ws As Worksheet
Dim LrD As Long, i&

Set Ws = Sheets("XUAT")

LrD = Ws.Range("D65536").End(xlUp).Row
If Not Application.Intersect(Range("D4", "D" & LrD), Range(Target.Address)) Is Nothing Then
   Ws.Range("E" & ActiveCell.Row & ":" & "F" & ActiveCell.Row).ClearContents
    If Ws.Range("A" & ActiveCell.Row).Value = "" Then
       Ws.Range("C" & ActiveCell.Row & ":" & "H" & ActiveCell.Row).ClearContents
       MsgBox "De nghi nhap: Ngay, Thang, Nam...! "
    End If
End If
If Application.Intersect(Target, Ws.Range("B4:B10000")) Is Nothing Then
i = Target.Row
    If Application.WorksheetFunction.CountIf(Ws.Range("B" & i & ":F" & i), "***") = 1 Then
        Application.EnableEvents = False
        Ws.Range("B3:F3").Copy Ws.Range("B" & i)
        Application.EnableEvents = True
    End If
End If

End Sub

@HUONGHCKT , cho mình hỏi chút nhé!
Với code này, khi mình insert thêm 1 hàng trước hàng 4 thì code chỉ copy ở hàng cuối+1, nhập các hàng tiếp theo thì không copy nữa.
Nhờ bạn giải thích vì sao giúp mình nhé và cho mình hướng xử lý với. Cảm ơn bạn!

 

[HUONGHCKT]

@HUONGHCKT , cho mình hỏi chút nhé!
Với code này, khi mình insert thêm 1 hàng trước hàng 4 thì code chỉ copy ở hàng cuối+1, nhập các hàng tiếp theo thì không copy nữa.
Nhờ bạn giải thích vì sao giúp mình nhé và cho mình hướng xử lý với. Cảm ơn bạn!

Bạn trông thấy chỗ này không? If ....CountIf(Ws.Range("B" & i & ":F" & i), "***") = 1 then tại sao lại phải là = 1 bởi vì cột B có công thức
Bạn chèn thêm dòng vào và cột B :F= rỗng do vậy nó end if luôn.

 

[Tuan.DNa]

Bạn trông thấy chỗ này không? If ....CountIf(Ws.Range("B" & i & ":F" & i), "***") = 1 then tại sao lại phải là = 1 bởi vì cột B có công thức
Bạn chèn thêm dòng vào và cột B :F= rỗng do vậy nó end if luôn.

Mình hiểu rồi. Chừ mình muốn xử lý chổ cột B đó từ dòng B5:F theo biến i Row đó được không bạn

 

[HUONGHCKT]

Mình hiểu rồi. Chừ mình muốn xử lý chổ cột B đó từ dòng B5:F theo biến i Row đó được không bạn

B5:B&dongcuoi không được, lý do đó là vùng đã có dữ liệu, có chăng bạn thử là B5:B&dongcuoi+1 hoặc 2 xem sao. Cứ thử đi, không được cách này thì ta dùng cachs khác. Cái đọng lại đó là kinh nghiệm và kiến thức vỡ vạc ra phần nào.

 

[Tuan.DNa]

B5:B&dongcuoi không được, lý do đó là vùng đã có dữ liệu, có chăng bạn thử là B5:B&dongcuoi+1 hoặc 2 xem sao. Cứ thử đi, không được cách này thì ta dùng cachs khác. Cái đọng lại đó là kinh nghiệm và kiến thức vỡ vạc ra phần nào.

Ý mình là cang thiệp chổ này nè
i = Target.Row

 

[HUONGHCKT]

Ý mình là cang thiệp chổ này nè
i = Target.Row

Chỗ này i=Target.row là tìm ô đang được bắt sự kiện nằm ở dòng nào thôi mà. còn ý bạn sao thì thực sự tôi không hiểu. Từ chố biết được dòng nào thì mới biết được paste chứ.

 

[Tuan.DNa]

Chỗ này i=Target.row là tìm ô đang được bắt sự kiện nằm ở dòng nào thôi mà. còn ý bạn sao thì thực sự tôi không hiểu. Từ chố biết được dòng nào thì mới biết được paste chứ.

Sáng mai mình test thử và tìm cách fix chổ này. Hiện mình đang đi chơi vs bạn.
Cảm ơn bạn nhé, chúc bạn buổi tối vui vẽ!

 

[Tuan.DNa]

Cũng với file trên. Giờ mình code cho:
1. Tự động kẻ border khi có dữ liệu.
Dim ws As Worksheet
Set ws = Worksheets("XUAT")
Dim LrD As Long
LrD = ws.Range("D65536").End(xlUp).Row

ws.Range("A4:H" & LrD+1).Borders.LineStyle = True
2. Hàm SumProduct theo dòng có dữ liệu.
- Dán KQ Sum Product cho 3 cột J, K, L vào vùng J2:L2
- Dữ liệu cột I là cố định và nhân cho các cột J, K, L để lấy Sumproduct.
- Lấy theo dòng cuối để KQ không bị lỗi dữ liệu cho hàm Sumproduct.
Dim Rng, Rng1, Rng2, Rng3 As Range
Set Rng = ws.Range("I4:I" & LrD)
Set Rng1 = ws.Range("J4:J" & LrD)
Set Rng2 = ws.Range("K4:K" & LrD)
Set Rng3 = ws.Range(""L4:L" & LrD)

' Làm mới vùng KQ trước khi chạy SumProduct
ws.Range("J2:L2").ClearContents

' Chạy code SumProduct và Dán KQ
ws.Range("J2") = Application.WorksheetFunction.SumProduct(Rng, Rng1)
ws.Range("K2") = Application.WorksheetFunction.SumProduct(Rng, Rng2)
ws.Range("L2") = Application.WorksheetFunction.SumProduct(Rng, Rng3)
------------------------
Với 2 code trên, nhờ Diễn đàn xem có tối ưu không, hoặc có code nào xin Diễn đàn hướng dẫn thêm.
Có 1 vấn đề phát sinh ở code 1 là: khi chạy các lần tiếp theo thì border không tự co giãn. Mặt dù đã thêm câu lệnh = False vào đầu thủ tục.
Mình xin Diễn đàn giúp là:
- Chạy code thì Xóa border, xử lý dữ liệu xong và dán KQ thì thực hiện kẻ border+thêm 1 dòng.
Mong Diễn đàn hổ trợ.
Cảm ơn các Anh, Chị nhiều nhé!

 

[Tuan.DNa]

Các bạn giúp mình ở code 1 nhé.
Mình đã thêm câu lệnh này sau câu lệnh = True.
ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone
Đã giải quyết được 1 phần, còn cái border thêm 1 dòng thì không giải quyết được.
Rất mong sự hổ trợ của các bạn.
Mình chân thành cảm ơn nhiều!

 

[HUONGHCKT]

Các bạn giúp mình ở code 1 nhé.
Mình đã thêm câu lệnh này sau câu lệnh = True.
ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone
Đã giải quyết được 1 phần, còn cái border thêm 1 dòng thì không giải quyết được.
Rất mong sự hổ trợ của các bạn.
Mình chân thành cảm ơn nhiều!

Không có file và code nên đoán mò"
1/ Thử tham khảo:
Sub Abc()
Dim LrD&
Dim....
LrD=Sh.Range("D65536").End(3).Row ' dòng cuối trước khi gán dữ liệu xuống sheet

...Code lấy dữ liệu và gán xuống sheet
(ví dụ lấy được t dòng)
If t then
ws.Range("A4:H" & LrD).Clearcontents ' Xóa bỏ dữ liệu cũ
Ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone 'định dạng vùng dữ liệu cũ (không đường kẻ)
Ws.Range("A"&LrD+1).resize(t,8)=mảng kết quả ' gán mảng kết quả xuống sheet
Ws.Range("A4:H" & LrD+t).Borders.LineStyle=1 ' định dạng lại vùng kết quả ( có đường kẻ khung)
xem sao.
2/ Nên khai báo
Dim Rng as Range, Rng1 as Range, Rng2 as Range
Thay cho
Dim Rng, Rng1, Rng2 as Range.
Khi báo như này thì VBA chỉ nhận Rng2 là range còn Rng, Rng1 là varial cho nên rất có thể kết quả tính toán sẽ sai hoặc bị lỗi. Không có file nên không thử được.

 

[Tuan.DNa]

Không có file và code nên đoán mò"
1/ Thử tham khảo:
Sub Abc()
Dim LrD&
Dim....
LrD=Sh.Range("D65536").End(3).Row ' dòng cuối trước khi gán dữ liệu xuống sheet

...Code lấy dữ liệu và gán xuống sheet
(ví dụ lấy được t dòng)
If t then
ws.Range("A4:H" & LrD).Clearcontents ' Xóa bỏ dữ liệu cũ
Ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone 'định dạng vùng dữ liệu cũ (không đường kẻ)
Ws.Range("A"&LrD+1).resize(t,8)=mảng kết quả ' gán mảng kết quả xuống sheet
Ws.Range("A4:H" & LrD+t).Borders.LineStyle=1 ' định dạng lại vùng kết quả ( có đường kẻ khung)
xem sao.
2/ Nên khai báo
Dim Rng as Range, Rng1 as Range, Rng2 as Range
Thay cho
Dim Rng, Rng1, Rng2 as Range.
Khi báo như này thì VBA chỉ nhận Rng2 là range còn Rng, Rng1 là varial cho nên rất có thể kết quả tính toán sẽ sai hoặc bị lỗi. Không có file nên không thử được.

Cảm ơn bạn nhiều nhé.

 

[Tuan.DNa]

Không có file và code nên đoán mò"
1/ Thử tham khảo:
Sub Abc()
Dim LrD&
Dim....
LrD=Sh.Range("D65536").End(3).Row ' dòng cuối trước khi gán dữ liệu xuống sheet

...Code lấy dữ liệu và gán xuống sheet
(ví dụ lấy được t dòng)
If t then
ws.Range("A4:H" & LrD).Clearcontents ' Xóa bỏ dữ liệu cũ
Ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone 'định dạng vùng dữ liệu cũ (không đường kẻ)
Ws.Range("A"&LrD+1).resize(t,8)=mảng kết quả ' gán mảng kết quả xuống sheet
Ws.Range("A4:H" & LrD+t).Borders.LineStyle=1 ' định dạng lại vùng kết quả ( có đường kẻ khung)
xem sao.
2/ Nên khai báo
Dim Rng as Range, Rng1 as Range, Rng2 as Range
Thay cho
Dim Rng, Rng1, Rng2 as Range.
Khi báo như này thì VBA chỉ nhận Rng2 là range còn Rng, Rng1 là varial cho nên rất có thể kết quả tính toán sẽ sai hoặc bị lỗi. Không có file nên không thử được.

Dear @HUONGHCKT
Code bạn đề xuất, như code mình đã đề cập ở bài 29+30.
Nhưng khi Run thì kẻ border không tự co giãn. Nghĩa là thủ tục con: tính toán SumProduct, lọc dữ liệu và trích xuất được 10 dòng. Chạy Run lần 2 và trích lọc được 5 dòng, thì border không co giãn còn 5 mà vẫn y nguyên border cho 10 dòng.
Nếu để câu lệnh:
Ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone
Ngay sau câu lệnh
ws.Range("A4:H" & LrD+1).Borders.LineStyle = True
Thì vấn đề tự co giãn border được giải quyết.
Nhưng phát sinh vấn đề khác:
Bấm Run lần 1 thì border không tạo ở dòng cuối +1(mà tạo xác dòng dữ liệu cuối). Bấm Run lần 2 thì lại được.
Mình không hiểu vấn đề lỗi nằm ở đâu nữa.
Bạn cho mình hỏi: trong câu lệnh trên, =True và =1 là giống hay khác nhau.
Chúc bạn buổi tối vui vẽ nhé. Cảm ơn nhiều!
Vấn đề khai báo Rng mình xin học hỏi và rút kinh nghiệm

 

[HUONGHCKT]

Dear @HUONGHCKT
Code bạn đề xuất, như code mình đã đề cập ở bài 29+30.
Nhưng khi Run thì kẻ border không tự co giãn. Nghĩa là thủ tục con: tính toán SumProduct, lọc dữ liệu và trích xuất được 10 dòng. Chạy Run lần 2 và trích lọc được 5 dòng, thì border không co giãn còn 5 mà vẫn y nguyên border cho 10 dòng.
Nếu để câu lệnh:
Ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone
Ngay sau câu lệnh
ws.Range("A4:H" & LrD+1).Borders.LineStyle = True
Thì vấn đề tự co giãn border được giải quyết.
Nhưng phát sinh vấn đề khác:
Bấm Run lần 1 thì border không tạo ở dòng cuối +1(mà tạo xác dòng dữ liệu cuối). Bấm Run lần 2 thì lại được.
Mình không hiểu vấn đề lỗi nằm ở đâu nữa.
Bạn cho mình hỏi: trong câu lệnh trên, =True và =1 là giống hay khác nhau.
Chúc bạn buổi tối vui vẽ nhé. Cảm ơn nhiều!
Vấn đề khai báo Rng mình xin học hỏi và rút kinh nghiệm

Nói chung là không có file và có code thì trong ai vạch hướng cho bạn cũng chỉ là "thầy bói xem voi" thôi.
Xem lại từ đầu, tôi thấy Việc tạo file giả định, hoặc có code của bạn (chạy chưa đúng ý định) là 1 điều hết sức xa xỉ đối với bạn. Thế cho nên bạn muốn biến người hộ trợ bạn thành thày bói, hay là kẻ đoán mò thật sao?

 

[Nu1Pr0]

Dear @HUONGHCKT
Code bạn đề xuất, như code mình đã đề cập ở bài 29+30.
Nhưng khi Run thì kẻ border không tự co giãn. Nghĩa là thủ tục con: tính toán SumProduct, lọc dữ liệu và trích xuất được 10 dòng. Chạy Run lần 2 và trích lọc được 5 dòng, thì border không co giãn còn 5 mà vẫn y nguyên border cho 10 dòng.
Nếu để câu lệnh:
Ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone
Ngay sau câu lệnh
ws.Range("A4:H" & LrD+1).Borders.LineStyle = True
Thì vấn đề tự co giãn border được giải quyết.
Nhưng phát sinh vấn đề khác:
Bấm Run lần 1 thì border không tạo ở dòng cuối +1(mà tạo xác dòng dữ liệu cuối). Bấm Run lần 2 thì lại được.
Mình không hiểu vấn đề lỗi nằm ở đâu nữa.
Bạn cho mình hỏi: trong câu lệnh trên, =True và =1 là giống hay khác nhau.
Chúc bạn buổi tối vui vẽ nhé. Cảm ơn nhiều!
Vấn đề khai báo Rng mình xin học hỏi và rút kinh nghiệm

Theo tôi
Ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone hoặc =0.
Và
Ws.Range("A4:H" & LrD+1).Borders.LineStyle=True hoặc =1.
Là như nhau
Không biết các cao thủ khác thì như thế nào!

 

[Tuan.DNa]

Toàn bộ code mình viết cho Sheet BC:
Sub Loc_BC()
Dim Lr, LrD, Lr_N, Lr_X, Lr_T As Long
Lr = Sheets("BC").Cells(Rows.Count, 4).End(xlUp).Row
LrD = Sheets("BC").Range("C65536").End(xlUp).Row

Lr_N = Sheets("NHAP").Cells(Rows.Count, 4).End(xlUp).Row
Lr_X = Sheets("XUAT").Cells(Rows.Count, 4).End(xlUp).Row
Lr_T = Sheets("TON").Cells(Rows.Count, 4).End(xlUp).Row
Set Target = Sheets("BC").Range("C6")
' -----------------------------------
If Target.Value = "N" Then
Sheets("BC").Range("A8:H" & Lr).ClearContents
Sheets("NHAP").Range("A2:H" & Lr_N).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("BC").Range("A5:E6"), CopyToRange:=Sheets("BC").Range("A7:H7"), Unique:=False
' --------------------------
End If
' -----------------------------------
If Target.Value = "X" Then
Sheets("BC").Range("A8:H" & Lr).ClearContents
Sheets("XUAT").Range("A2:H" & Lr_N).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("BC").Range("A5:E6"), CopyToRange:=Sheets("BC").Range("A7:H7"), Unique:=False

End If
' -----------------------------------
If Target.Value = "T" Then
Sheets("BC").Range("A8:H" & Lr).ClearContents
Sheets("TON").Range("A5:H" & Lr_N).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("BC").Range("A5:E6"), CopyToRange:=Sheets("BC").Range("A7:H7"), Unique:=False

End If
' -----------------------------------
If Target.Value = "" Then
' (Thong bao ko chon chuc nang loc)
MsgBox "De nghi chon bao cao N, X, T...! "
Exit Sub
End If
' -----------------------------------
Sheets("BC").Range("A8:H" & LrD + 1).Borders.LineStyle = True
Sheets("BC").Range("A8:H" & LrD + 1).Borders.LineStyle = xlNone

End Sub
---------------
Trường hợp để 2 câu lệnh gần nhau:
Sheets("BC").Range("A8:H" & LrD + 1).Borders.LineStyle = True
Sheets("BC").Range("A8:H" & LrD + 1).Borders.LineStyle = xlNone
Lọc BC như hình (1)

Trường hợp để 1 câu lệnh đầu thủ tục và 1 câu lệnh cuối thủ tục:
Sheets("BC").Range("A8:H" & LrD + 1).Borders.LineStyle = xlNone
' ,...................
thủ tục con
' ....................
Sheets("BC").Range("A8:H" & LrD + 1).Borders.LineStyle = True
Lọc BC như hình (2)

Các bạn xem giúp mình nhé.

 

[Tuan.DNa]

Các bạn fix giùm lỗi ở code trên giúp mình nhé.
Cảm ơn sự giúp đở của các bạn rất rất nhiều nha

 

[ngochienbmt]

Cách kẻ dòng thì mình thấy đơn giản nhất là copy paste định dạng là ổn nhất

 

[Tuan.DNa]

Cách kẻ dòng thì mình thấy đơn giản nhất là copy paste định dạng là ổn nhất

Vậy bạn cho mình hướng dẫn code được không. Kiểu copy, paste theo định dạng. Mong bạn hổ trợ giúp mình nhé!

 

[ngochienbmt]

Vậy bạn cho mình hướng dẫn code được không. Kiểu copy, paste theo định dạng. Mong bạn hổ trợ giúp mình nhé!

Có ji mai nha bạn. On bằng đt nên ko gửi đc. Code mình thế này. Khi bạn có dữ liệu ở dòng cuối ( bạn có thể đặt 1 cộ nào đó để kiểm tra dòng cuối là dòng nào sau đó copy định dạng dòng bên trên pase xuống dòng cuối đó. Cứ khi nào dòng cuối được hình thành là kế tiếp pase định dạng. Ko có dòng cuối thì ko đingj dạng

Bài đã được tự động gộp: 5/10/23

Bác gửi file lên đi mai rãnh mình làm thử xem