HoangHung81
Thành viên mới
- Tham gia
- 5/9/12
- Bài viết
- 5
- Được thích
- 0
Chào các bạn !
Mình là thành viên viên mới rất mong dược sự giúp đỡ của các bạn, vấn đề của mình là sau khi mài mò sưu tầm trên diễn đàn Giải Pháp Excell và lấy râu ông nọ cắm cằm bà kia thì mình được đoạn code sau:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Vung As Range, iHang As Long, iNhay As Long
On Error Resume Next
If Not Intersect(Target, [B7:B10000]) Is Nothing Then
If Target.Count = 1 Then
Dim Sh As Worksheet, Rng As Range, sRng As Range
Set Sh = ThisWorkbook.Worksheets("khoiluong")
Set Rng = Sh.Range(Sh.[b6], Sh.[B65500].End(xlUp))
Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
sRng.Resize(1, 5).Copy Destination:=Sheets("p.tich").[D65432].End(xlUp).Offset(1, -2)
Set Vung = Sheets("d.lieu1").Range(Sheets("d.lieu1").[c2], Sheets("d.lieu1").[c10000].End(xlUp)).Offset(, -1)
iHang = Application.WorksheetFunction.Match(Target, Vung, 0)
iNhay = Vung(iHang).End(xlDown).Row - Vung(iHang + 1, 0).Row
Vung(iHang).Offset(1, 1).Resize(iNhay, 9).Copy Destination:=Sheets("p.tich").[D65432].End(xlUp).Offset(1, -1)
End If
End If
End Sub
Mình có 3 sheet : d.lieu1, khoiluong, p.tich, code chạy thấy cũng đúng với ý mình nhưng vấn đề gặp phải là khi thay đổi thứ tự và giá ở sheet khoiluong thì sheet p.tich không cập nhật theo, và lỡ enter nhiêu lần trong cột B của sheet khoiluong sheet thì p.tich sẽ copy từ sheet dulieu1 sang nhiều lần . Nên mình cần giải quyết là tạo 1 nút bấm để xóa tất cả dữ liệu o sheet p.tich và kích hoạt code như trên thực hiện, vậy thì sừa code lại như thế nào rất mong được sự giúp đỡ của các bạn!. file đính kèm
Mình là thành viên viên mới rất mong dược sự giúp đỡ của các bạn, vấn đề của mình là sau khi mài mò sưu tầm trên diễn đàn Giải Pháp Excell và lấy râu ông nọ cắm cằm bà kia thì mình được đoạn code sau:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Vung As Range, iHang As Long, iNhay As Long
On Error Resume Next
If Not Intersect(Target, [B7:B10000]) Is Nothing Then
If Target.Count = 1 Then
Dim Sh As Worksheet, Rng As Range, sRng As Range
Set Sh = ThisWorkbook.Worksheets("khoiluong")
Set Rng = Sh.Range(Sh.[b6], Sh.[B65500].End(xlUp))
Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
sRng.Resize(1, 5).Copy Destination:=Sheets("p.tich").[D65432].End(xlUp).Offset(1, -2)
Set Vung = Sheets("d.lieu1").Range(Sheets("d.lieu1").[c2], Sheets("d.lieu1").[c10000].End(xlUp)).Offset(, -1)
iHang = Application.WorksheetFunction.Match(Target, Vung, 0)
iNhay = Vung(iHang).End(xlDown).Row - Vung(iHang + 1, 0).Row
Vung(iHang).Offset(1, 1).Resize(iNhay, 9).Copy Destination:=Sheets("p.tich").[D65432].End(xlUp).Offset(1, -1)
End If
End If
End Sub
Mình có 3 sheet : d.lieu1, khoiluong, p.tich, code chạy thấy cũng đúng với ý mình nhưng vấn đề gặp phải là khi thay đổi thứ tự và giá ở sheet khoiluong thì sheet p.tich không cập nhật theo, và lỡ enter nhiêu lần trong cột B của sheet khoiluong sheet thì p.tich sẽ copy từ sheet dulieu1 sang nhiều lần . Nên mình cần giải quyết là tạo 1 nút bấm để xóa tất cả dữ liệu o sheet p.tich và kích hoạt code như trên thực hiện, vậy thì sừa code lại như thế nào rất mong được sự giúp đỡ của các bạn!. file đính kèm
