tranaidh
Thành viên mới
- Tham gia
- 31/5/08
- Bài viết
- 36
- Được thích
- 0
Em có một file nhập dữ liệu của hệ thống nhưng có lỗi code. Em nhờ mọi người giúp chỉnh lại code giúp em với ạ
Mã:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
If Sh.Name = "DANH SACH MINH CHUNG" Then
Dim sh_info As Worksheet
Dim sh_list As Worksheet
Set sh_info = Sheets("DANH SACH MINH CHUNG")
Set sh_list = Sheets("Danh_muc")
If Target.Count = 1 And Target.Row >= 12 And Target.Column = 1 Then
If Target.Value <> "" Then
sh_list.Select
'read all row of Danh_muc sheet
FinalRow = sh_list.Cells(Rows.Count, "C").End(xlUp).Row
sh_info.Select
Dim arr As Variant
For x = 4 To FinalRow
ThisValue = sh_list.Cells(x, "C").Value
Standard = sh_list.Cells(x, "B").Value
If Standard = CStr(Target.Value) Then
'add to array
If IsEmpty(arr) Then
ReDim arr(0 To 0) As Variant
ElseIf IsError(Application.Match(ThisValue, arr, 0)) Then
ReDim Preserve arr(0 To UBound(arr) + 1)
End If
arr(UBound(arr)) = ThisValue
End If
Next x
'set criteria dropdown
Let rngIndex = "B" & Target.Row & ":" & "B" & Target.Row
Dim cellRef As Range
Set cellRef = sh_info.Range(rngIndex)
cellRef.ClearContents
Dim valueFormula
valueFormula = Join(arr, ",")
With cellRef.Validation
.Delete
.Add Type:=xlValidateList, Formula1:=valueFormula
.ErrorMessage = StrConv("", vbUnicode)
End With
'remove validate of level
Let rngIndexLevel = "C" & Target.Row & ":" & "C" & Target.Row
Dim cellRefLevel As Range
Set cellRefLevel = sh_info.Range(rngIndexLevel)
cellRefLevel.Validation.Delete
cellRefLevel.ClearContents
Cells(Target.Row, 1).Select
End If
ElseIf Target.Count = 1 And Target.Row >= 12 And Target.Column = 2 Then
StandardValue = sh_info.Cells(Target.Row, "A").Value
If Target.Value <> "" And StandardValue <> "" Then
sh_list.Select
FinalRow = sh_list.Cells(Rows.Count, "D").End(xlUp).Row
sh_info.Select
Dim arr2 As Variant
For x = 4 To FinalRow
ThisValue = sh_list.Cells(x, "D").Value
Standard = sh_list.Cells(x, "B").Value
Criteria = sh_list.Cells(x, "C").Value
If Standard = CStr(StandardValue) And Criteria = Target.Value Then
If IsEmpty(arr2) Then
ReDim arr2(0 To 0) As Variant
ElseIf IsError(Application.Match(ThisValue, arr2, 0)) Then
ReDim Preserve arr2(0 To UBound(arr2) + 1)
End If
arr2(UBound(arr2)) = ThisValue
End If
Next x
Let rngIndex = "C" & Target.Row & ":" & "C" & Target.Row
Dim cellRef2 As Range
Set cellRef2 = sh_info.Range(rngIndex)
cellRef2.ClearContents
Dim valueFormula2
valueFormula2 = Join(arr2, ",")
With cellRef2.Validation
.Delete
.Add Type:=xlValidateList, Formula1:=valueFormula2
.ErrorMessage = ""
End With
Cells(Target.Row, 2).Select
End If
End If
End If
Application.EnableEvents = True
End Sub
)
