Giúp code tìm kiếm (1 người xem)

[levanhoa1977]

Các pro giúp với. Mình có một sheet lấy dự liệu từ 2 sheet khác. Khi gõ Mã khách hàng thì lấy dữ liệu từ bảng khách hàng. Khi gõ mã sản phẩm thì lấy thông tin từ bảng sản phẩm ( đã làm rồi). Và công thức tính tiền tự động nhảy,

Cảm ơn.

 

[giaiphap]

File bị lỗi bạn ơi, không mở được.

 

[levanhoa1977]

Tải về đọc bình thường mà.

 

[giaiphap]

Đã tải lại lần 2 không đọc được (Báo lỗi khi mở)

 

[levanhoa1977]

Tải lại file. Xem lại giúp nha.
Cảm ơn

 

[giaiphap]

Tải lại file. Xem lại giúp nha.
Cảm ơn

Công thức của bạn có rồi mà nhờ gì vậy bạn.

 

[levanhoa1977]

Công thức của bạn có rồi mà nhờ gì vậy bạn.

Mình muốn tích hợp dùng code không dùng công thức giống như cột G mình đã làm và muốn tích hợp cột E và M. Khi dữ liệu lên 10.000 dòng thì file chạy ko nổi. Nhưng code thì tốt hơn.

 

[giaiphap]

Vậy bạn thêm câu lệnh màu đỏ phía dưới vào sự kiện Worksheet_Change như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rTarget As Range, aTarget, i As Long
  Dim Arr1(), Arr2(), tmp
  On Error Resume Next
  If Dic Is Nothing Then Auto_Open
  If Not Intersect(Range("G10:G10000"), Target) Is Nothing Then
    Set rTarget = Intersect(Range("G10:G10000"), Target)
    Update rTarget
[COLOR=#ff0000][B]    Target.Offset(, 6).FormulaR1C1 =[/B][/COLOR][COLOR=#ff0000][B]"=+ROUND(RC[-3]*RC[-2]*(1-RC[-1]),0)"[/B][/COLOR]
  End If
End Sub

 

[levanhoa1977]

Vậy bạn thêm câu lệnh màu đỏ phía dưới vào sự kiện Worksheet_Change như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rTarget As Range, aTarget, i As Long
  Dim Arr1(), Arr2(), tmp
  On Error Resume Next
  If Dic Is Nothing Then Auto_Open
  If Not Intersect(Range("G10:G10000"), Target) Is Nothing Then
    Set rTarget = Intersect(Range("G10:G10000"), Target)
    Update rTarget
[COLOR=#ff0000][B]    Target.Offset(, 6).FormulaR1C1 = "=+ROUND(R[-1]C[-3]*R[-1]C[-2]*(1-R[-1]C[-1]),0)"[/B][/COLOR]
  End If
End Sub

Nhưng code lấy tên khách hàng từ bảng khách hàng qua khi ta gõ mã khách hàng.

 

[giaiphap]

Vậy bạn sửa code lại như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rTarget As Range, aTarget, i As Long
  Dim Arr1(), Arr2(), tmp
  On Error Resume Next
  If Dic Is Nothing Then Auto_Open
  If Not Intersect(Range("G10:G10000"), Target) Is Nothing Then
    Set rTarget = Intersect(Range("G10:G10000"), Target)
    Update rTarget
    Target.Offset(, 6).FormulaR1C1 = "=+ROUND(RC[-3]*RC[-2]*(1-RC[-1]),0)"
  ElseIf Not Intersect(Range("E10:E10000"), Target) Is Nothing Then
    Dim tim As Range
    Set tim = Sheet2.Range("B2:B10000").Find(Target.Value)
    If Not tim Is Nothing Then Target.Offset(, 1).Value = tim.Offset(, 2).Value
    Set tim = Nothing
  End If
End Sub

 

[levanhoa1977]

Vậy bạn sửa code lại như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rTarget As Range, aTarget, i As Long
  Dim Arr1(), Arr2(), tmp
  On Error Resume Next
  If Dic Is Nothing Then Auto_Open
  If Not Intersect(Range("G10:G10000"), Target) Is Nothing Then
    Set rTarget = Intersect(Range("G10:G10000"), Target)
    Update rTarget
    Target.Offset(, 6).FormulaR1C1 = "=+ROUND(RC[-3]*RC[-2]*(1-RC[-1]),0)"
  ElseIf Not Intersect(Range("E10:E10000"), Target) Is Nothing Then
    Dim tim As Range
    Set tim = Sheet2.Range("B2:B10000").Find(Target.Value)
    If Not tim Is Nothing Then Target.Offset(, 1).Value = tim.Offset(, 2).Value
    Set tim = Nothing
  End If
End Sub

Được rồi bạn. Cảm ơn bạn nhiều.