Khi nhập số thứ tự ở 1 sheet tự động copy các dữ liệu ở sheet tham chiếu đến. (2 người xem)

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

ftthua2003

Thành viên chính thức
Tham gia
15/8/08
Bài viết
97
Được thích
11
Tình hình là mình muốn lập 01 cái mẫu cho công trường để giảm bớt thời gian khi báo cáo, nhưng lập ra mẫu rồi copy sửa code tương tự không chạy được. Nên mình nhờ đại gia đình GPE giúp mình với
Nội dung và mục đích file mình đã ghi chú trong bảng đính kèm.
Cảm ơn và chúc cả nhà sức khỏe!!
 
Lần chỉnh sửa cuối:
Tình hình là mình muốn lập 01 cái mẫu cho công trường để giảm bớt thời gian khi báo cáo, nhưng lập ra mẫu rồi copy sửa code tương tự không chạy được. Nên mình nhờ đại gia đình GPE giúp mình với
Nội dung và mục đích file mình đã ghi chú trong bảng đính kèm.
Cảm ơn và chúc cả nhà sức khỏe!!

Tại B2, sheet2 chọn và xem kết quả.

Vùng A2:A14 (vùng màu xanh) bạn muốn thay mã hàng gì là tùy bạn, còn muốn hơn nữa thì sửa Name.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
em cảm ơn anh Quang hải nghe. những code không chạy đúng với những số thứ tự chỉ có phía dưới 02 dòng anh ah. Em gửi lại nhờ a giúp e làm sao chạy đúng với trường hợp anh đã giúp và trường hợp này nữa anh nhe.
Thay code này vào
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A17:A1000]) Is Nothing Then
   If Target.Count > 1 Then Exit Sub
   Dim rng As Range, i, Fr, Lr, tam, r
   Set rng = Sheet2.[A:A].Find(Target, , , 1)
   If Not rng Is Nothing Then
      For i = 1 To 5
         If i <> 2 Then Target.Offset(, i) = rng.Offset(, i)
      Next
      Target.Offset(, 8) = rng.Offset(1, 3)
      Fr = rng.Offset(2, 2).Address
      If rng.Offset(3, 2) <> "" Then
         Lr = rng.Offset(2, 2).End(4).Address
      Else
         Lr = Fr
      End If
      r = Target.Row
      tam = Sheet2.Range(Fr, Lr).Resize(, 3).Value
      Target.Offset(1, 7).Resize(UBound(tam), 3).Value = tam
      Target.Offset(1, 11).Resize(UBound(tam)) = "=RC[-1]*R" & r & "C[-5]"
   End If
End If
End Sub
 
Upvote 0
dạ cảm ơn anh , đúng rồi anh ah. Một làn nữa cảm ơn anh Quang Hai Rất nhiều..
 
Upvote 0
Thay code này vào
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A17:A1000]) Is Nothing Then
   If Target.Count > 1 Then Exit Sub
   Dim rng As Range, i, Fr, Lr, tam, r
   Set rng = Sheet2.[A:A].Find(Target, , , 1)
   If Not rng Is Nothing Then
      For i = 1 To 5
         If i <> 2 Then Target.Offset(, i) = rng.Offset(, i)
      Next
      Target.Offset(, 8) = rng.Offset(1, 3)
      Fr = rng.Offset(2, 2).Address
      If rng.Offset(3, 2) <> "" Then
         Lr = rng.Offset(2, 2).End(4).Address
      Else
         Lr = Fr
      End If
      r = Target.Row
      tam = Sheet2.Range(Fr, Lr).Resize(, 3).Value
      Target.Offset(1, 7).Resize(UBound(tam), 3).Value = tam
      Target.Offset(1, 11).Resize(UBound(tam)) = "=RC[-1]*R" & r & "C[-5]"
   End If
End If
End Sub
Anh quang hai oi! giúp e với. khi e nhập số thứ tự >1000 trong sheet thi code trên không chạy nữa anh ah. Em cũng đã thử thay đổi code của anh; [A17:A1000]) thành [A17:A20000]) thì vãn không chạy anh ah. Em nhờ nh giúp e với.
Cảm ơn anh rất nhiều. CHúc anh mạnh khỏe!!!
 
Upvote 0

Bài viết mới nhất

Back
Top Bottom