Em có 2 sheet tên lần lượt là “ BKL1” và “BKL”. Trong đó sheet” BKL1” là gồm các số liệu và tai cột N có các mã “ 1,2,a, b,c,d” . Nhờ anh chị trong diễn đàn viết giúp code để sang sheet” BKL” tại cột N gõ các mã hiệu tương ứng sẽ lấy được dữ liệu bên sheet” BKL1”. Trong sheet “ BKL1” mã 1 có 1 dòng thì sẽ lấy được 1 dòng dữ liệu tướng ứng sang sheet “ BKL”, trong sheet “ BKL1” mã a có 2 dòng thì sẽ lấy được 2 dòng dữ liệu tướng ứng sang sheet “ BKL”, trong sheet “ BKL1” mã b có 3 dòng thì sẽ lấy được 3 dòng dữ liệu tướng ứng sang sheet “ BKL”,.Tương tự với các mã c, d, 3,4 . Em xin cảm ơn ạ
Em có 2 sheet tên lần lượt là “ BKL1” và “BKL”. Trong đó sheet” BKL1” là gồm các số liệu và tai cột N có các mã “ 1,2,a, b,c,d” . Nhờ anh chị trong diễn đàn viết giúp code để sang sheet” BKL” tại cột N gõ các mã hiệu tương ứng sẽ lấy được dữ liệu bên sheet” BKL1”. Trong sheet “ BKL1” mã 1 có 1 dòng thì sẽ lấy được 1 dòng dữ liệu tướng ứng sang sheet “ BKL”, trong sheet “ BKL1” mã a có 2 dòng thì sẽ lấy được 2 dòng dữ liệu tướng ứng sang sheet “ BKL”, trong sheet “ BKL1” mã b có 3 dòng thì sẽ lấy được 3 dòng dữ liệu tướng ứng sang sheet “ BKL”,.Tương tự với các mã c, d, 3,4 . Em xin cảm ơn ạ
@HUONGHCKT Anh chị xem giúp em phần này với ạ... khi em gõ mã : 1 thì nó lại lên 2 dòng ạ trong khi sheet "BKL1" dữ liệu là 1 dòng ạ.. còn gõ mã :4 thì báo không có trong thư viện ạ.. khi em xóa dòng bên sheet:BKL thì code báo lỗi, và khi gõ mà khác vào thì code không chạy nữa ạ
@HUONGHCKT Anh chị xem giúp em phần này với ạ... khi em gõ mã : 1 thì nó lại lên 2 dòng ạ trong khi sheet "BKL1" dữ liệu là 1 dòng ạ.. còn gõ mã :4 thì báo không có trong thư viện ạ.. khi em xóa dòng bên sheet:BKL thì code báo lỗi, và khi gõ mà khác vào thì code không chạy nữa ạ
Lưu ý code mã cuối cùng có thể sẽ không chính xác (do không tìm thấy d- ví dụ ở sheet BKL1 ô N10 = C và dữ liệu trải dài đến tận M20 ), không biết bạn chủ thớt có nhận thấy không?Để khác phục tình trạng trên thay code cụ bằng code này:
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo End_Code1
If Not Intersect(Target, Range("N5:N10000")) Is Nothing Then ' 12 Lµ Ṽ TRƯ CéT T¦¥NG ¦NG LA L
' Application.EnableEvents = False
Dim Tm, i&, j, eR As Long, d&, Lr&
On Error GoTo End_Code2
Lr = Sheet1.Range("K" & Rows.Count).End(3).Row
eR = WorksheetFunction.Match(Target.Value, Sheet1.Columns("N"), 0)
d = Sheet1.Range("N" & eR).End(xlDown).Row
If Sheet1.Range("N" & eR + 1) = Empty Then
If d > Lr Then d = Lr Else d = d - 1
Else
d = eR
End If
Sheet1.Range("A" & eR & ":M" & d).Copy Target.Offset(, -13)
Sheet1.Range("O" & eR & ":Q" & d).Copy Target.Offset(, 1)
Application.EnableEvents = True
End If
End_Code1:
Application.EnableEvents = True
Exit Sub
End_Code2:
MsgBox "Kieu trong hoac khong co trong thu vien"
Target.Offset(, 1).Resize(, 12).ClearContents
GoTo End_Code1
End Sub
Lưu ý code mã cuối cùng có thể sẽ không chính xác (do không tìm thấy d- ví dụ ở sheet BKL1 ô N10 = C và dữ liệu trải dài đến tận M20 ), không biết bạn chủ thớt có nhận thấy không?Để khác phục tình trạng trên thay code cụ bằng code này:
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo End_Code1
If Not Intersect(Target, Range("N5:N10000")) Is Nothing Then ' 12 Lµ Ṽ TRƯ CéT T¦¥NG ¦NG LA L
' Application.EnableEvents = False
Dim Tm, i&, j, eR As Long, d&, Lr&
On Error GoTo End_Code2
Lr = Sheet1.Range("K" & Rows.Count).End(3).Row
eR = WorksheetFunction.Match(Target.Value, Sheet1.Columns("N"), 0)
d = Sheet1.Range("N" & eR).End(xlDown).Row
If Sheet1.Range("N" & eR + 1) = Empty Then
If d > Lr Then d = Lr Else d = d - 1
Else
d = eR
End If
Sheet1.Range("A" & eR & ":M" & d).Copy Target.Offset(, -13)
Sheet1.Range("O" & eR & ":Q" & d).Copy Target.Offset(, 1)
Application.EnableEvents = True
End If
End_Code1:
Application.EnableEvents = True
Exit Sub
End_Code2:
MsgBox "Kieu trong hoac khong co trong thu vien"
Target.Offset(, 1).Resize(, 12).ClearContents
GoTo End_Code1
End Sub
Lưu ý code mã cuối cùng có thể sẽ không chính xác (do không tìm thấy d- ví dụ ở sheet BKL1 ô N10 = C và dữ liệu trải dài đến tận M20 ), không biết bạn chủ thớt có nhận thấy không?Để khác phục tình trạng trên thay code cụ bằng code này:
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo End_Code1
If Not Intersect(Target, Range("N5:N10000")) Is Nothing Then ' 12 Lµ Ṽ TRƯ CéT T¦¥NG ¦NG LA L
' Application.EnableEvents = False
Dim Tm, i&, j, eR As Long, d&, Lr&
On Error GoTo End_Code2
Lr = Sheet1.Range("K" & Rows.Count).End(3).Row
eR = WorksheetFunction.Match(Target.Value, Sheet1.Columns("N"), 0)
d = Sheet1.Range("N" & eR).End(xlDown).Row
If Sheet1.Range("N" & eR + 1) = Empty Then
If d > Lr Then d = Lr Else d = d - 1
Else
d = eR
End If
Sheet1.Range("A" & eR & ":M" & d).Copy Target.Offset(, -13)
Sheet1.Range("O" & eR & ":Q" & d).Copy Target.Offset(, 1)
Application.EnableEvents = True
End If
End_Code1:
Application.EnableEvents = True
Exit Sub
End_Code2:
MsgBox "Kieu trong hoac khong co trong thu vien"
Target.Offset(, 1).Resize(, 12).ClearContents
GoTo End_Code1
End Sub
đoạn code chạy được khi em copy code vào trong sheet "BKL" ạ... nhưng copy vào thisworkbook thì không chạy được ạ... anh chị có thể giúp thêm khi các sheets mới tạo ra có tên tai cột Q tại sheet "BKL1" thì vẫn lấy được dữ liệu tại tại sheet"BKL1" sang các sheet đó với ạ. Mong anh chị giúp thêm phần này ạ @HUONGHCKT
đoạn code chạy được khi em copy code vào trong sheet "BKL" ạ... nhưng copy vào thisworkbook thì không chạy được ạ... anh chị có thể giúp thêm khi các sheets mới tạo ra có tên tai cột Q tại sheet "BKL1" thì vẫn lấy được dữ liệu tại tại sheet"BKL1" sang các sheet đó với ạ. Mong anh chị giúp thêm phần này ạ @HUONGHCKT
Theo tôi hiểu thì Code Private Sub Worksheet_Change(ByVal Target As Range) đặt trong ThisWorkbook sẽ không chạy được.
Phải chăng bạn muốn là khi thêm các Sheet khác (ví dụ là sheet ABC , CDE, .... gì đấy) để khi gõ 1 ký tự vào Cột N thì code sẽ chạy như đã chạy trong sheet BKL, mà bạn không cần copy code bắt sẽ kiện ở sheet mới.
Nếu sheet BKL1 là sheet để lấy dữ liệu (ta tạm gọi là Data nguồn) , Để sheet sau này đều chạy được như Private Sub Worksheet_Change(ByVal Target As Range) của sheet BKL
Theo tôi thì :
1/ Hình như là viết 1 class modulle là thực hiện được ý tưởng trên thì phải. Cái này thì tôi botay.com xin cờ trắng.
2/ bạn dùng hàm người dùng (hàm tự tạo-UDF). Khi ấy bạn chỉ cần gõ hàm vào bất cú ô nào và đưa tham số đúng là sẽ cho ra kết quả. Ví Dụ = LayDL("C") và nhấn Enter.
3/Viết 1 Public sub để lấy dữ liệu với tham số là 1 Range
Mã:
Public Sub CopyDL(ByVal Rng As Range)
' Application.EnableEvents = False
Dim Tm, i&, j, eR As Long, d&, Lr&
On Error GoTo End_Code2
If Not Rng Is Nothing Then
Lr = Sheet1.Range("K" & Rows.Count).End(3).Row
eR = WorksheetFunction.Match(Rng.Value, Sheet1.Columns("N"), 0)
d = Sheet1.Range("N" & eR).End(xlDown).Row
If Sheet1.Range("N" & eR + 1) = Empty Then
If d > Lr Then d = Lr Else d = d - 1
Else
d = eR
End If
Sheet1.Range("A" & eR & ":M" & d).Copy Rng.Offset(, -13)
Sheet1.Range("O" & eR & ":Q" & d).Copy Rng.Offset(, 1)
Application.EnableEvents = True
End If
End_Code1:
Application.EnableEvents = True
Exit Sub
End_Code2:
MsgBox "Kieu trong hoac khong co trong thu vien"
Rng.Offset(, 1).Resize(, 12).ClearContents
GoTo End_Code1
End Sub
Sau đó khi them các sheets mới bạn Bạn chỉ việc copy đoạn code dưới đây và paste vào module sheet.
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("N5:N10000")) Is Nothing Then
Call CopyDL(Target)
End If
End Sub
Và từ bây giờ khi bạn gõ vào cột N thì đoạn code Private Sub Worksheet_Change(ByVal Target As Range) sẽ chạy.
@All: Mong các anh, chị, em... ghé xem bài và cho ý kiến, thực hiện ý tưởng trên và khai sáng cho tôi và có ai đó nữa cần thêm tư liệu học tập.
Trân trọng cảm ơn
Theo tôi hiểu thì Code Private Sub Worksheet_Change(ByVal Target As Range) đặt trong ThisWorkbook sẽ không chạy được.
Phải chăng bạn muốn là khi thêm các Sheet khác (ví dụ là sheet ABC , CDE, .... gì đấy) để khi gõ 1 ký tự vào Cột N thì code sẽ chạy như đã chạy trong sheet BKL, mà bạn không cần copy code bắt sẽ kiện ở sheet mới.
Nếu sheet BKL1 là sheet để lấy dữ liệu (ta tạm gọi là Data nguồn) , Để sheet sau này đều chạy được như Private Sub Worksheet_Change(ByVal Target As Range) của sheet BKL
Theo tôi thì :
1/ Hình như là viết 1 class modulle là thực hiện được ý tưởng trên thì phải. Cái này thì tôi botay.com xin cờ trắng.
2/ bạn dùng hàm người dùng (hàm tự tạo-UDF). Khi ấy bạn chỉ cần gõ hàm vào bất cú ô nào và đưa tham số đúng là sẽ cho ra kết quả. Ví Dụ = LayDL("C") và nhấn Enter.
3/Viết 1 Public sub để lấy dữ liệu với tham số là 1 Range
Mã:
Public Sub CopyDL(ByVal Rng As Range)
' Application.EnableEvents = False
Dim Tm, i&, j, eR As Long, d&, Lr&
On Error GoTo End_Code2
If Not Rng Is Nothing Then
Lr = Sheet1.Range("K" & Rows.Count).End(3).Row
eR = WorksheetFunction.Match(Rng.Value, Sheet1.Columns("N"), 0)
d = Sheet1.Range("N" & eR).End(xlDown).Row
If Sheet1.Range("N" & eR + 1) = Empty Then
If d > Lr Then d = Lr Else d = d - 1
Else
d = eR
End If
Sheet1.Range("A" & eR & ":M" & d).Copy Rng.Offset(, -13)
Sheet1.Range("O" & eR & ":Q" & d).Copy Rng.Offset(, 1)
Application.EnableEvents = True
End If
End_Code1:
Application.EnableEvents = True
Exit Sub
End_Code2:
MsgBox "Kieu trong hoac khong co trong thu vien"
Rng.Offset(, 1).Resize(, 12).ClearContents
GoTo End_Code1
End Sub
Sau đó khi them các sheets mới bạn Bạn chỉ việc copy đoạn code dưới đây và paste vào module sheet.
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("N5:N10000")) Is Nothing Then
Call CopyDL(Target)
End If
End Sub
Và từ bây giờ khi bạn gõ vào cột N thì đoạn code Private Sub Worksheet_Change(ByVal Target As Range) sẽ chạy.
@All: Mong các anh, chị, em... ghé xem bài và cho ý kiến, thực hiện ý tưởng trên và khai sáng cho tôi và có ai đó nữa cần thêm tư liệu học tập.
Trân trọng cảm ơn
Dạ vâng đúng rồi ạ... Kiểu mình thêm 1 sheet mới có tên khác thì vẫn chạy được code mà mình không phải copy và dán copy kia vào trong sheet mới ạ.mà các sheet mới có tên đặt lần lượt như trong cột Q của sheet " BKl1" ạ
Theo tôi hiểu thì Code Private Sub Worksheet_Change(ByVal Target As Range) đặt trong ThisWorkbook sẽ không chạy được.
Phải chăng bạn muốn là khi thêm các Sheet khác (ví dụ là sheet ABC , CDE, .... gì đấy) để khi gõ 1 ký tự vào Cột N thì code sẽ chạy như đã chạy trong sheet BKL, mà bạn không cần copy code bắt sẽ kiện ở sheet mới.
Nếu sheet BKL1 là sheet để lấy dữ liệu (ta tạm gọi là Data nguồn) , Để sheet sau này đều chạy được như Private Sub Worksheet_Change(ByVal Target As Range) của sheet BKL
Theo tôi thì :
1/ Hình như là viết 1 class modulle là thực hiện được ý tưởng trên thì phải. Cái này thì tôi botay.com xin cờ trắng.
2/ bạn dùng hàm người dùng (hàm tự tạo-UDF). Khi ấy bạn chỉ cần gõ hàm vào bất cú ô nào và đưa tham số đúng là sẽ cho ra kết quả. Ví Dụ = LayDL("C") và nhấn Enter.
3/Viết 1 Public sub để lấy dữ liệu với tham số là 1 Range
Mã:
Public Sub CopyDL(ByVal Rng As Range)
' Application.EnableEvents = False
Dim Tm, i&, j, eR As Long, d&, Lr&
On Error GoTo End_Code2
If Not Rng Is Nothing Then
Lr = Sheet1.Range("K" & Rows.Count).End(3).Row
eR = WorksheetFunction.Match(Rng.Value, Sheet1.Columns("N"), 0)
d = Sheet1.Range("N" & eR).End(xlDown).Row
If Sheet1.Range("N" & eR + 1) = Empty Then
If d > Lr Then d = Lr Else d = d - 1
Else
d = eR
End If
Sheet1.Range("A" & eR & ":M" & d).Copy Rng.Offset(, -13)
Sheet1.Range("O" & eR & ":Q" & d).Copy Rng.Offset(, 1)
Application.EnableEvents = True
End If
End_Code1:
Application.EnableEvents = True
Exit Sub
End_Code2:
MsgBox "Kieu trong hoac khong co trong thu vien"
Rng.Offset(, 1).Resize(, 12).ClearContents
GoTo End_Code1
End Sub
Sau đó khi them các sheets mới bạn Bạn chỉ việc copy đoạn code dưới đây và paste vào module sheet.
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("N5:N10000")) Is Nothing Then
Call CopyDL(Target)
End If
End Sub
Và từ bây giờ khi bạn gõ vào cột N thì đoạn code Private Sub Worksheet_Change(ByVal Target As Range) sẽ chạy.
@All: Mong các anh, chị, em... ghé xem bài và cho ý kiến, thực hiện ý tưởng trên và khai sáng cho tôi và có ai đó nữa cần thêm tư liệu học tập.
Trân trọng cảm ơn
Dạ... Em muốn sau các sheet có tên là BKl2,BKl3... Đến Bkl5 em có đặt tên trong cột Q của sheet Bkl1 cũng sẽ lấy được dữ liệu bên sheet Bkl1 như sheet BKL mà đoạn code trên anh chị đã code giúp ạ
Dạ... Em muốn sau các sheet có tên là BKl2,BKl3... Đến Bkl5 em có đặt tên trong cột Q của sheet Bkl1 cũng sẽ lấy được dữ liệu bên sheet Bkl1 như sheet BKL mà đoạn code trên anh chị đã code giúp ạ
Trong khi chờ đợi các anh chị, em khác viết cho 1 class module bạn thực hiện như 3/ của bài #12. tức là khi tạo thêm 1 sheet mới bạn chỉ việc copy cái đoạn code bắt sự kiện thay đổi cột N là được mà.