Xin Anh chị giúp Code trả về một giá trị tương ứng khi thỏa mãn điều kiện

[LeHang.93]

Các bác hướng dẫn giúp em, hiện tại em muốn code để khi nhập vào bảng trên thì nó sẽ nhảy theo điều kiện bên dưới ( theo các chữ màu đỏ) tức là chỉ cần nhập vào cột O và P, sau đó ấn phím thì các cột kia sẽ nhảy tự động theo điều kiện ( cột k, cột s)

 

[HieuCD]

Các bác hướng dẫn giúp em, hiện tại em muốn code để khi nhập vào bảng trên thì nó sẽ nhảy theo điều kiện bên dưới ( theo các chữ màu đỏ) tức là chỉ cần nhập vào cột O và P, sau đó ấn phím thì các cột kia sẽ nhảy tự động theo điều kiện ( cột k, cột s)
View attachment 260422

Chép code vào sheet1

Option Explicit
Dim sTK$, aNV()
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim jC&, iR&, i&
  If Target.Count = 1 Then 'chi chay khi nhap 1 cell
    jC = Target.Column
    If jC < 14 Or jC > 16 Then Exit Sub 'Khac cot "O" va "P"
    If sTK = Empty Then
      aNV = Range("V7:Z11").Value
      For i = 1 To UBound(aNV)
        sTK = sTK & "," & aNV(i, 1)
      Next i
    End If
    iR = Int((InStr(1, sTK, Mid(Target.Value, 1, 3)) + 2) / 4)
    If iR > 0 Then 'Thuoc nhom TK 111,112,156,153,152
      Application.EnableEvents = False
      Range("K" & Target.Row) = aNV(iR, 5) 'Kho
      If jC = 15 Then
        Range("S" & Target.Row) = aNV(iR, 3) 'TK no
      Else
        Range("S" & Target.Row) = aNV(iR, 4) 'TK co
      End If
      Application.EnableEvents = True
    End If
  End If
End Sub

 

[LeHang.93]

Chép code vào sheet1

Option Explicit
Dim sTK$, aNV()
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim jC&, iR&, i&
  If Target.Count = 1 Then 'chi chay khi nhap 1 cell
    jC = Target.Column
    If jC < 14 And jC > 16 Then Exit Sub 'Khac cot "O" va "P"
    If sTK = Empty Then
      aNV = Range("V7:Z11").Value
      For i = 1 To UBound(aNV)
        sTK = sTK & "," & aNV(i, 1)
      Next i
    End If
    iR = Int((InStr(1, sTK, Mid(Target.Value, 1, 3)) + 2) / 4)
    If iR > 0 Then 'Thuoc nhom TK 111,112,156,153,152
      Application.EnableEvents = False
      Range("K" & Target.Row) = aNV(iR, 5) 'Kho
      If jC = 15 Then
        Range("S" & Target.Row) = aNV(iR, 3) 'TK no
      Else
        Range("S" & Target.Row) = aNV(iR, 4) 'TK co
      End If
      Application.EnableEvents = True
    End If
  End If
End Sub

Thanks bác nhưng em thử nhập vào không chạy ạ !

 

[HieuCD]

Thanks bác nhưng em thử nhập vào không chạy ạ !

Nhập tay chỗ nào mà không chạy, thêm lệnh xóa nếu không phải tài khoản xét điều kiện, nếu không muốn xóa thì dùng code

Option Explicit
Dim sTK$, aNV()
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim jC&, iR&, i&
  If Target.Count = 1 Then 'chi chay khi nhap 1 cell
    jC = Target.Column
    If jC < 14 Or jC > 16 Then Exit Sub 'Khac cot "O" va "P"
    If sTK = Empty Then
      aNV = Range("V7:Z11").Value
      For i = 1 To UBound(aNV)
        sTK = sTK & "," & aNV(i, 1)
      Next i
    End If
    iR = Int((InStr(1, sTK, Mid(Target.Value, 1, 3)) + 2) / 4)
    Application.EnableEvents = False
    If iR > 0 Then 'Thuoc nhom TK 111,112,156,153,152
      Range("K" & Target.Row) = aNV(iR, 5) 'Kho
      If jC = 15 Then
        Range("S" & Target.Row) = aNV(iR, 3) 'TK no
      Else
        Range("S" & Target.Row) = aNV(iR, 4) 'TK co
      End If
    Else
      Range("K" & Target.Row) = Empty
      Range("S" & Target.Row) = Empty
    End If
    Application.EnableEvents = True
  End If
End Sub

trước

 

[batman1]

Nhập tay chỗ nào mà không chạy,

jC = Target.Column
If jC < 14 And jC > 16 Then Exit Sub 'Khac cot "O" va "P"

1. Người ta kêu vì tới bài #3 chỉ có duy nhất 1 tập tin ở bài #1 mà trong nó làm gì có bảng nào ở V7:Z11. Trong bài #1 bảng ở H33:L37.

2. Dòng

If jC < 14 And jC > 16 Then Exit Sub

là thừa vì không có một số nào vừa nhỏ hơn 14 vừa lớn hơn 16.
Chắc là OR.

 

[HieuCD]

1. Người ta kêu vì tới bài #3 chỉ có duy nhất 1 tập tin ở bài #1 mà trong nó làm gì có bảng nào ở V7:Z11. Trong bài #1 bảng ở H33:L37.

2. Dòng

If jC < 14 And jC > 16 Then Exit Sub

là thừa vì không có một số nào vừa nhỏ hơn 14 vừa lớn hơn 16.
Chắc là OR.

Hic Hic Hic!!!. Đã chỉnh các code trước

 

[LeHang.93]

Hic Hic Hic!!!. Đã chỉnh các code trước

dạ em cảm ơn bác nhiều ạ

Bài đã được tự động gộp: 12/6/21

1. Người ta kêu vì tới bài #3 chỉ có duy nhất 1 tập tin ở bài #1 mà trong nó làm gì có bảng nào ở V7:Z11. Trong bài #1 bảng ở H33:L37.

2. Dòng

If jC < 14 And jC > 16 Then Exit Sub

là thừa vì không có một số nào vừa nhỏ hơn 14 vừa lớn hơn 16.
Chắc là OR.

Dạ em cảm ơn anh ạ

Bài đã được tự động gộp: 12/6/21

Nhập tay chỗ nào mà không chạy, thêm lệnh xóa nếu không phải tài khoản xét điều kiện, nếu không muốn xóa thì dùng code

Option Explicit
Dim sTK$, aNV()
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim jC&, iR&, i&
  If Target.Count = 1 Then 'chi chay khi nhap 1 cell
    jC = Target.Column
    If jC < 14 Or jC > 16 Then Exit Sub 'Khac cot "O" va "P"
    If sTK = Empty Then
      aNV = Range("V7:Z11").Value
      For i = 1 To UBound(aNV)
        sTK = sTK & "," & aNV(i, 1)
      Next i
    End If
    iR = Int((InStr(1, sTK, Mid(Target.Value, 1, 3)) + 2) / 4)
    Application.EnableEvents = False
    If iR > 0 Then 'Thuoc nhom TK 111,112,156,153,152
      Range("K" & Target.Row) = aNV(iR, 5) 'Kho
      If jC = 15 Then
        Range("S" & Target.Row) = aNV(iR, 3) 'TK no
      Else
        Range("S" & Target.Row) = aNV(iR, 4) 'TK co
      End If
    Else
      Range("K" & Target.Row) = Empty
      Range("S" & Target.Row) = Empty
    End If
    Application.EnableEvents = True
  End If
End Sub

trước

Dạ chạy rồi ạ, nhưng có 2 vấn đề ạ
1 là nếu nhập một tài khoản ( ví dụ xxx) không nằm trong bảng tham chiếu thì các cột K và S sẽ bị mất luôn ạ ( mong muốn của em là nếu nhập mà ko liên quan hoặc ko nằm trong bảng tham chiếu thì ưu tiên những tài khoản đã có tham chiếu
2. Nếu em coppy xuống dòng thì các cột K và S ko chạy được ạ

 

[LeHang.93]

dạ em cảm ơn bác nhiều ạ

Bài đã được tự động gộp: 12/6/21

Dạ em cảm ơn anh ạ

Bài đã được tự động gộp: 12/6/21

Dạ chạy rồi ạ, nhưng có 2 vấn đề ạ
1 là nếu nhập một tài khoản ( ví dụ xxx) không nằm trong bảng tham chiếu thì các cột K và S sẽ bị mất luôn ạ ( mong muốn của em là nếu nhập mà ko liên quan hoặc ko nằm trong bảng tham chiếu thì ưu tiên những tài khoản đã có tham chiếu
2. Nếu em coppy xuống dòng thì các cột K và S ko chạy được ạ

bác có thể giúp em là khi nhập thì ko cần nhảy luôn, nhưng sau khi tạo một button ấn vào, thì nó sẽ rà và điền theo bảng điều kiện kia theo thứ tự ưu tiên bất kỳ ạ

 

[HieuCD]

bác có thể giúp em là khi nhập thì ko cần nhảy luôn, nhưng sau khi tạo một button ấn vào, thì nó sẽ rà và điền theo bảng điều kiện kia theo thứ tự ưu tiên bất kỳ ạ

Xóa code trước, insert module

Option Explicit
Sub ABC()
  Dim aNV(), aTK(), aKho(), aLoai(), sTK$
  Dim eRow&, sRow&, i&, j&, iR&

  With Sheets("Sheet1")
    eRow = .Range("V" & Rows.Count).End(xlUp).Row
    If eRow < 7 Then MsgBox "Khong co du lieu!": Exit Sub
    aNV = .Range("V7:Z" & eRow).Value
    For i = 1 To UBound(aNV)
      sTK = sTK & "," & Mid(aNV(i, 1), 1, 3)
    Next i
    eRow = .Range("O" & Rows.Count).End(xlUp).Row
    i = .Range("P" & Rows.Count).End(xlUp).Row
    If eRow < i Then eRow = i
    If eRow < 7 Then MsgBox "Khong co du lieu!": Exit Sub
    aTK = .Range("O7:P" & eRow).Value
    aKho = .Range("K7:K" & eRow).Value
    aLoai = .Range("S7:S" & eRow).Value
    sRow = UBound(aTK)
    
    For i = 1 To sRow
      For j = 1 To 2
        If aTK(i, j) <> Empty Then
          iR = Int((InStr(1, sTK, Mid(aTK(i, j), 1, 3)) + 2) / 4)
          If iR > 0 Then 'Thuoc nhom TK 111,112,156,153,152
            aKho(i, 1) = aNV(iR, 5) 'Kho
            aLoai(i, 1) = aNV(iR, 2 + j) ' j=1 loaiTK No  ,j=2 loaiTK  Co
          End If
        End If
      Next j
    Next i
    Application.ScreenUpdating = False
    .Range("K7:K" & eRow).Value = aKho
    .Range("S7:S" & eRow).Value = aLoai
    Application.ScreenUpdating = True
  End With
End Sub

và chép code vào

 

[LeHang.93]

Xóa code trước, insert module

Option Explicit
Sub ABC()
  Dim aNV(), aTK(), aKho(), aLoai(), sTK$
  Dim eRow&, sRow&, i&, j&, iR&

  With Sheets("Sheet1")
    eRow = .Range("V" & Rows.Count).End(xlUp).Row
    If eRow < 7 Then MsgBox "Khong co du lieu!": Exit Sub
    aNV = .Range("V7:Z" & eRow).Value
    For i = 1 To UBound(aNV)
      sTK = sTK & "," & Mid(aNV(i, 1), 1, 3)
    Next i
    eRow = .Range("O" & Rows.Count).End(xlUp).Row
    i = .Range("P" & Rows.Count).End(xlUp).Row
    If eRow < i Then eRow = i
    If eRow < 7 Then MsgBox "Khong co du lieu!": Exit Sub
    aTK = .Range("O7:P" & eRow).Value
    aKho = .Range("K7:K" & eRow).Value
    aLoai = .Range("S7:S" & eRow).Value
    sRow = UBound(aTK)
   
    For i = 1 To sRow
      For j = 1 To 2
        If aTK(i, j) <> Empty Then
          iR = Int((InStr(1, sTK, Mid(aTK(i, j), 1, 3)) + 2) / 4)
          If iR > 0 Then 'Thuoc nhom TK 111,112,156,153,152
            aKho(i, 1) = aNV(iR, 5) 'Kho
            aLoai(i, 1) = aNV(iR, 2 + j) ' j=1 loaiTK No  ,j=2 loaiTK  Co
          End If
        End If
      Next j
    Next i
    Application.ScreenUpdating = False
    .Range("K7:K" & eRow).Value = aKho
    .Range("S7:S" & eRow).Value = aLoai
    Application.ScreenUpdating = True
  End With
End Sub

và chép code vào

Anh à anh nhiệt tình quá, cho e xin sđt ko ạ, em muốn gửi anh chút phí ạ

 

[HieuCD]

Anh à anh nhiệt tình quá, cho e xin sđt ko ạ, em muốn gửi anh chút phí ạ

Giúp được bạn mình vui rồi. Chúc bạn và gia đình vui khỏe

 

[LeHang.93]

Nhập tay chỗ nào mà không chạy, thêm lệnh xóa nếu không phải tài khoản xét điều kiện, nếu không muốn xóa thì dùng code

Option Explicit
Dim sTK$, aNV()
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim jC&, iR&, i&
  If Target.Count = 1 Then 'chi chay khi nhap 1 cell
    jC = Target.Column
    If jC < 14 Or jC > 16 Then Exit Sub 'Khac cot "O" va "P"
    If sTK = Empty Then
      aNV = Range("V7:Z11").Value
      For i = 1 To UBound(aNV)
        sTK = sTK & "," & aNV(i, 1)
      Next i
    End If
    iR = Int((InStr(1, sTK, Mid(Target.Value, 1, 3)) + 2) / 4)
    Application.EnableEvents = False
    If iR > 0 Then 'Thuoc nhom TK 111,112,156,153,152
      Range("K" & Target.Row) = aNV(iR, 5) 'Kho
      If jC = 15 Then
        Range("S" & Target.Row) = aNV(iR, 3) 'TK no
      Else
        Range("S" & Target.Row) = aNV(iR, 4) 'TK co
      End If
    Else
      Range("K" & Target.Row) = Empty
      Range("S" & Target.Row) = Empty
    End If
    Application.EnableEvents = True
  End If
End Sub

trước

Cho em hỏi thêm nếu sử dụng code này nhưng muốn coppy mã mà tham chiếu vẫn nhảy theo thì thêm gì được ạ