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

Liên hệ QC

LeHang.93

Thành viên chính thức
Tham gia
20/8/20
Bài viết
53
Được thích
9
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)
Untitled.jpg
 

File đính kèm

  • Check.xlsx
    20 KB · Đọc: 8
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
Mã:
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
 
Lần chỉnh sửa cuối:
Upvote 0
Chép code vào sheet1
Mã:
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 ạ !
 
Upvote 0
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
Mã:
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
 

File đính kèm

  • Check.xlsb
    22.6 KB · Đọc: 15
Lần chỉnh sửa cuối:
Upvote 0
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
Mã:
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. :D
Chắc là OR.
 
Upvote 0
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
Mã:
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. :D
Chắc là OR.
Hic Hic Hic!!!. Đã chỉnh các code trước
 
Upvote 0
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:

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
Mã:
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. :D
Chắc là OR.
Dạ em cảm ơn anh ạ
Bài đã được tự động gộp:

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
Mã:
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 ạ
 
Lần chỉnh sửa cuối:
Upvote 0
dạ em cảm ơn bác nhiều ạ
Bài đã được tự động gộp:


Dạ em cảm ơn anh ạ
Bài đã được tự động gộp:


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ỳ ạ
 
Upvote 0
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
Mã:
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
 

File đính kèm

  • Check.xlsb
    27.5 KB · Đọc: 12
Upvote 0
Xóa code trước, insert module
Mã:
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í ạ
 
Upvote 0
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
Mã:
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 ạ
 
Upvote 0
Web KT
Back
Top Bottom