
14-11-16, 18:10
|
 | Συντονιστής Όνομα: Σπύρος Τσιλιγιάννης Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010, Ms-Office 2013, Ms-Office 2016, Ms-Office 365 Γλώσσα λογισμικού Office: Ελληνική, Αγγλική | | Εγγραφή: 22-11-2011 Περιοχή: Αθήνα
Μηνύματα: 2.321
| |
Θεωρούμε ότι η λίστα πελατών, είναι στην στήλη Α, από 4 γραμμή και κάτω. Κώδικας: Private Sub Worksheet_Change(ByVal Target As Range)
Dim cust As Range
Set cust = Me.Cells(3, 3)
If Intersect(Target, cust) Is Nothing Then Exit Sub
Dim Nr As Long
Nr = Me.Cells(Rows.Count, 1).End(xlUp).Row
Dim c As Range, iRng As Range
Set iRng = Me.Range("a4:a" & Nr)
For Each c In iRng
If Application.WorksheetFunction.CountIf(iRng, cust.Value) > 0 Then
End
Else
Me.Cells(Nr + 1, 1).Value = cust.Value
End
End If
Next c
End Sub
Ο κώδικας στο φύλλο, συμβάν Change.
Αν αυτό που επιλέγω ή πληκτρολογώ στο c3, υπάρχει στην λίστα:
Καμία ενέργεια
Αν αυτό που επιλέγω ή πληκτρολογώ στο c3, δεν υπάρχει στην λίστα:
Η λίστα συμπληρώνεται με το νέο όνομα.
|