السلام عليكم ورحمة الله تعالى وبركاته
جربت دمج هذين الكودين ولم افلح
اليكم الكودين
1 خاص بالورقة
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("d4")) Is Nothing Then
If [a2] = 1 Then
Application.ScreenUpdating = False
If Target.Text = "ãÈíÚÇÊ" Then '---------------------------
Range("H4").Validation.Delete
Range("H4").Validation.Add Type:=xlValidateList, Formula1:="=seller"
[d5] = Application.WorksheetFunction.Max(Sheet3.Range("b5:b10000")) + 1
End If
If Target.Text = "ãÔÊÑíÇÊ" Then
[a1] = 2
Range("H4").Validation.Delete
Range("H4").Validation.Add Type:=xlValidateList, Formula1:="=buyer"
[d5] = Application.WorksheetFunction.Max(Sheet4.Range("b5:b10000")) + 1
End If
End If
If Target.Text = "ãÈíÚÇÊ" Then [a1] = 3
If Target.Text = "ãÔÊÑíÇÊ" Then [a1] = 2
End If
If Not Intersect(Target, Range("h4:i4")) Is Nothing Then
If Range("d4").Text = "ãÈíÚÇÊ" Then '---------------------------
Range("f5") = Application.WorksheetFunction.VLookup(Target, Sheet1.Range("q5:s5000"), 2, 0)
Range("h5") = Application.WorksheetFunction.VLookup(Target, Sheet1.Range("q5:s5000"), 3, 0)
End If
If Range("d4").Text = "ãÔÊÑíÇÊ" Then '---------------------------
Range("f5") = Application.WorksheetFunction.VLookup(Target, Sheet1.Range("t5:v5000"), 2, 0)
Range("h5") = Application.WorksheetFunction.VLookup(Target, Sheet1.Range("t5:v5000"), 3, 0)
End If
If [h4] = "" Then Range("f5") = ""
If [h4] = "" Then Range("h5") = ""
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("e8:g32,b8:b32,f5,h5")) Is Nothing Then Cells(Target.Row, 1).Select
If Not Intersect(Target, Range("f4")) Is Nothing And [a2] = 1 Then UserForm1.Show
If Not Intersect(Target, Range("f4,h4")) Is Nothing And [a2] = 2 Then Cells(Target.Row, 1).Select
If Not Intersect(Target, Range("d5")) Is Nothing And [a2] = 1 Then Cells(Target.Row, 1).Select
End Sub
2 خاص بـ Combobox
Dim a(), mémo, f
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set f = Sheets("Mar")
Set zSaisie = Range("D12:D35")
If Not Intersect(zSaisie, Target) Is Nothing And Target.Count = 1 Then
If mémo <> "" Then If IsError(Application.Match(Range(mémo), a, 0)) Then Range(mémo) = ""
a = Application.Transpose(f.Range("a2:a" & f.[A65000].End(xlUp).Row))
Me.ComboBox1.List = a
Me.ComboBox1.Height = Target.Height + 3
Me.ComboBox1.Width = Target.Width
Me.ComboBox1.Top = Target.Top
Me.ComboBox1.Left = Target.Left
Me.ComboBox1 = Target
Me.ComboBox1.Visible = True
Me.ComboBox1.Activate
mémo = Target.Address
Else
Me.ComboBox1.Visible = False
End If
End Sub
Private Sub ComboBox1_Change()
If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then
Set d1 = CreateObject("Scripting.Dictionary")
tmp = UCase(Me.ComboBox1) & "*"
For Each c In a
If UCase(c) Like tmp Then d1(c) = ""
Next c
Me.ComboBox1.List = d1.keys
Me.ComboBox1.DropDown
End If
ActiveCell.Value = Me.ComboBox1
End Sub
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ComboBox1.List = Application.Transpose(f.Range("a2:a" & f.[A65000].End(xlUp).Row))
Me.ComboBox1.DropDown
End Sub
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
If IsError(Application.Match(ActiveCell, a, 0)) Then ActiveCell = ""
ActiveCell.Offset(1).Select
End If
End Sub
facture.xls