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

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài
Có
HUONGHCKT đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Mình dùng hàm dòng cuối. Cảm ơn bạn đã hướng dẫn nha.
 
HUONGHCKT đã viết:
Sáng ra, làm đại 1 quả, hy vọng đúng ý.
Thay code cũ bằng code này:
Mã: 
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
Nhấp chuột vào đây để mở rộng...
@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!
 
Tuan.DNa đã viết:
@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!
Nhấp chuột vào đây để mở rộng...
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.
 
HUONGHCKT đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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
 
Tuan.DNa đã viết:
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
Nhấp chuột vào đây để mở rộng...
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.
 
HUONGHCKT đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Ý mình là cang thiệp chổ này nè
i = Target.Row
 
Tuan.DNa đã viết:
Ý mình là cang thiệp chổ này nè
i = Target.Row
Nhấp chuột vào đây để mở rộng...
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ứ.
 
HUONGHCKT đã viết:
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ứ.
Nhấp chuột vào đây để mở rộng...
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ẽ!
 
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é!
 
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!
 
Tuan.DNa đã viết:
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!
Nhấp chuột vào đây để mở rộng...
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.
 
HUONGHCKT đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn nhiều nhé.
 
HUONGHCKT đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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
 
Tuan.DNa đã viết:
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
Nhấp chuột vào đây để mở rộng...
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?
 
Tuan.DNa đã viết:
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
Nhấp chuột vào đây để mở rộng...
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!
 
Lần chỉnh sửa cuối:
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é.
 

File đính kèm

  • 1.jpg
    1.jpg
    139.7 KB · Đọc: 9
  • 2.jpg
    2.jpg
    107.4 KB · Đọc: 9
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
 
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 đã viế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é!
Nhấp chuột vào đây để mở rộng...
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:

Bác gửi file lên đi mai rãnh mình làm thử xem
 
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

hongquan93vn
Tìm công thức có thể đánh STT của giá trị mỗi lần xuất hiện
2
Trả lời
26
Đọc
391
ptm0412
ptm0412
HuynhThiMinhPhung
tìm và thay thế giá trị rỗng
Trả lời
2
Đọc
52
VetMini
V
hongphuong1997
  • Question
Lấy các ký tự bất kỳ trong các ô
Trả lời
2
Đọc
64
hongphuong1997
hongphuong1997
HuynhThiMinhPhung
nối dữ liệu từ nhiều worksheet
Trả lời
3
Đọc
103
HuynhThiMinhPhung
HuynhThiMinhPhung
LuuGiaPhúc
Tìm công thức mảng tính giá trị lớn nhất theo từng hàng
Trả lời
9
Đọc
182
VetMini
V
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