Forum

Αναζήτηση στο ms-office.gr

Πάμε!
ms-office.gr > Forum > Microsoft Excel > Excel - Ερωτήσεις / Απαντήσεις > [VBA] Σύγκριση τιμών ComboBox από το ίδιο το ComboBox.

Excel - Ερωτήσεις / Απαντήσεις Ότι έχει σχέση με συναρτήσεις, μορφοποίηση, εκτυπώσεις γραφήματα κτλ.

Απάντηση στο θέμα

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 06-02-13, 16:03
Το avatar του χρήστη anestaki
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 06-02-2010
Μηνύματα: 198
Προεπιλογή Σύγκριση τιμών ComboBox από το ίδιο το ComboBox.

Έχω μια αναπτυσσόμενη λίστα στην όπια θα ήθελα να συγκρίνω τις τιμές της με των εαυτό της δηλαδή να αποκλείσω διπλό έγραφες.
Παράλληλα να εγράφη μια νέα τιμή και να κάνη Refresh.
Κώδικας:
Dim i As Long
i = Φύλλο16.Range("c" & Rows.Count).End(xlUp).Row
If i > 2 Then Φύλλο16.Range("c" & i + 1).Value = ComboBox2
If ComboBox2.ListIndex = ComboBox2 Then Φύλλο16.Range("c" & i + 1).Value = ""
Απάντηση με παράθεση
  #2  
Παλιά 07-02-13, 01:03
Το avatar του χρήστη Tasos
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 2016, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.234
Προεπιλογή

Πέρασε τον παρακάτω κώδικα σε μια φόρμα με ένα σύνθετο πλαίσιο με το όνομα "Combobox1" και δοκίμασε.

Ο κώδικας αυτός:
  • Γεμίζει και ταξινομεί τα στοιχεία του "Combobox1" με δεδομένα από τη στήλη C του φύλλου με το
    κωδικό όνομα Sheet1 αγνοώντας τυχόν κενά κελιά.
  • Αν πληκτρολογηθεί τιμή που δεν υπάρχει στη λίστα, μετά από πάτημα του Enter θα ερωτηθεί ο
    χρήστης αν θέλει να καταχωρηθεί νέα εγγραφή στο φύλλο.
  • Μετά από την καταχώρηση το σύνθετο πλαίσιο ενημερώνεται, ταξινομείται εκ νέου και η νέα εγγραφή θα επιλεγεί.

Option Explicit
Private rng As Range, c As Range

Private Sub UserForm_Initialize()
With Sheet1
If Application.CountA(Range(.Cells(2, 3), .Cells(2, 3).End(xlDown))) Then
Set rng = Range(.Cells(2, 3), .Cells(Rows.Count, 3).End(xlUp))
FillCombo ComboBox1, rng
Else
Set rng = .Cells(1, 3)
End If
End With
End Sub

Private Sub ComboBox1_KeyUp( _
ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)

If Trim(ComboBox1.Text) = "" Then Exit Sub
ComboBox1.Text = Trim(ComboBox1.Text)
If KeyCode = vbKeyReturn Then
Set c = rng.Find(ComboBox1.Text, LookIn:=xlValues)
If c Is Nothing Then
If MsgBox("Η εγγραφή αυτή δεν υπάρχει στη λίστα." & _
" Να την καταχωρήσω;", vbQuestion + vbYesNo) = vbYes Then
Set rng = rng.Resize(rng.Rows.Count + 1, 1)
If rng.Row = 1 Then
Set rng = rng.Offset(1).Resize(1, 1)
rng.Value = ComboBox1.Text
'rng.Value = Application.Proper(ComboBox1.Text) 'το πρώτο γράμμα της λέξης κεφαλαίο
ComboBox1.AddItem rng.Text
Else
rng(rng.Rows.Count).Value = ComboBox1.Text
'rng(rng.Rows.Count).Value = Application.Proper(ComboBox1.Text) 'το πρώτο γράμμα της λέξης κεφαλαίο
FillCombo ComboBox1, rng
End If
ComboBox1.Value = rng(rng.Rows.Count).Text
End If
End If
End If
End Sub

Private Sub FillCombo( _
ByVal cbo As MSForms.ComboBox, _
ByVal rng As Range)
Dim c As Range, i As Long, x As Long, sw1, sw2, Itm
Dim Coll As New Collection
On Error Resume Next
For Each c In rng
Coll.Add c.Value, c.Text
Next
On Error GoTo 0
For i = 1 To Coll.Count - 1
For x = i + 1 To Coll.Count
If UCase(Coll(i)) > UCase(Coll(x)) Then
sw1 = Coll(i)
sw2 = Coll(x)
Coll.Add sw1, before:=x
Coll.Add sw2, before:=i
Coll.Remove i + 1
Coll.Remove x + 1
End If
Next x
Next i
cbo.Clear
For Each Itm In Coll
cbo.AddItem Itm
Next Itm
End Sub
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών

Τελευταία επεξεργασία από το χρήστη Tasos : 07-02-13 στις 10:29.
Απάντηση με παράθεση
  #3  
Παλιά 07-02-13, 22:25
Το avatar του χρήστη anestaki
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 06-02-2010
Μηνύματα: 198
Προεπιλογή

Καλησπέρα
Τάσο σε ευχαριστώ που συνεχίζεις να με υποστηρίζεις
Ενώ δουλεύει κανονικά όπως μου είπες όταν το χρησιμοποιώ στην δική μου φόρμα δεν λειτουργεί
Και θα ήθελα να μου υπόδειξη το λάθος μου.
Κώδικας:
Option Explicit
Private rng As Range, c As Range

Private Sub UserForm_Initialize()
ComboBox1.List() = Φύλλο3.Range("AA1:AA24").Value
ComboBox1 = Φύλλο3.Range("G7").Value
TextBox1 = Φύλλο3.Range("l7").Value
TextBox2 = Φύλλο3.Range("n7").Value
TextBox2 = Format(Me.TextBox2, "dd-mm-yyyy")
TextBox3 = Φύλλο3.Range("j10").Value
TextBox4 = Φύλλο3.Range("j11").Value
TextBox5 = Φύλλο3.Range("j12").Value
TextBox6 = Φύλλο3.Range("j13").Value
TextBox7 = Φύλλο3.Range("j14").Value
TextBox8 = Φύλλο3.Range("j15").Value
TextBox9 = Φύλλο3.Range("j16").Value
TextBox10 = Φύλλο3.Range("j17").Value
ComboBox2 = Φύλλο3.Range("g15").Value
ComboBox3 = Φύλλο3.Range("g16").Value
ComboBox4 = Φύλλο3.Range("g17").Value
With Φύλλο16
If Application.CountA(Range(.Cells(2, 3), .Cells(2, 3).End(xlDown))) Then
Set rng = Range(.Cells(2, 3), .Cells(Rows.Count, 3).End(xlUp))
FillCombo ComboBox2, rng
Else
Set rng = .Cells(1, 3)
End If
End With
ComboBox3.List = ComboBox2.List
ComboBox4.List = ComboBox2.List
ComboBox5.List = ComboBox2.List
ComboBox6.List = ComboBox2.List
ComboBox8.List = ComboBox2.List
ComboBox9.List = ComboBox2.List
ComboBox10.List = ComboBox2.List
ComboBox19.List = ComboBox2.List


End Sub
Private Sub ComboBox2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If Trim(ComboBox2.Text) = "" Then Exit Sub
ComboBox2.Text = Trim(ComboBox2.Text)
If KeyCode = vbKeyReturn Then
Set c = rng.Find(ComboBox2.Text, LookIn:=xlValues)
If c Is Nothing Then
If MsgBox("Η εγγραφή αυτή δεν υπάρχει στη λίστα." & " Να την καταχωρήσω;", vbQuestion + vbYesNo) = vbYes Then
Set rng = rng.Resize(rng.Rows.Count + 1, 1)
If rng.Row = 1 Then
Set rng = rng.Offset(1).Resize(1, 1)
rng.Value = ComboBox2.Text
ComboBox2.AddItem rng.Text
Else
rng(rng.Rows.Count).Value = ComboBox2.Text
FillCombo ComboBox2, rng
End If
ComboBox2.Value = rng(rng.Rows.Count).Text
End If
End If
End If
End Sub

 
Private Sub FillCombo(ByVal cbo As MSForms.ComboBox, ByVal rng As Range)
Dim c As Range, i As Long, x As Long, sw1, sw2, Itm
Dim Coll As New Collection
On Error Resume Next
For Each c In rng
Coll.Add c.Value, c.Text
Next
On Error GoTo 0
For i = 1 To Coll.Count - 1
For x = i + 1 To Coll.Count
If UCase(Coll(i)) > UCase(Coll(x)) Then
sw1 = Coll(i)
sw2 = Coll(x)
Coll.Add sw1, before:=x
Coll.Add sw2, before:=i
Coll.Remove i + 1
Coll.Remove x + 1
End If
Next x
Next i
cbo.Clear
For Each Itm In Coll
cbo.AddItem Itm
Next Itm
End Sub
Απάντηση με παράθεση
  #4  
Παλιά 08-02-13, 01:46
Το avatar του χρήστη Tasos
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 2016, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.234
Προεπιλογή

Το πλήκτρο Enter θα πυροδοτήσει το συμβάν KeyUp() μόνο αν δεν μεταφερθεί η εστίαση σε άλλο πεδίο (AutoTab).


Αντικατέστησε λοιπόν τον κώδικα:

Κώδικας:
Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        .......................
        .......................
End Sub
με τον παρακάτω:

Κώδικας:
Private Sub ComboBox1_AfterUpdate()
    If Trim(ComboBox1.Text) = "" Then Exit Sub
    ComboBox1.Text = Trim(ComboBox1.Text)
    Set c = rng.Find(ComboBox1.Text, LookIn:=xlValues)
    If c Is Nothing Then
        If MsgBox("Η εγγραφή αυτή δεν υπάρχει στη λίστα." & _
                " Να την καταχωρήσω;", vbQuestion + vbYesNo) = vbYes Then
            Set rng = rng.Resize(rng.Rows.Count + 1, 1)
            If rng.Row = 1 Then
                Set rng = rng.Offset(1).Resize(1, 1)
                rng.Value = ComboBox1.Text
                ComboBox1.AddItem rng.Text
            Else
                rng(rng.Rows.Count).Value = ComboBox1.Text
                FillCombo ComboBox1, rng
            End If
            ComboBox1.Value = rng(rng.Rows.Count).Text
        End If
    End If
End Sub
Καλή συνέχεια!

Τάσος
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών
Απάντηση με παράθεση
  #5  
Παλιά 08-02-13, 13:49
Το avatar του χρήστη anestaki
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 06-02-2010
Μηνύματα: 198
Προεπιλογή

Καλημέρα σε όλους
Τάσο σε ευχαριστώ παρά πολύ μπορεί να το έψαχνα μέρες.
Φιλικά Γιώργος
Απάντηση με παράθεση
Απάντηση στο θέμα

Εργαλεία Θεμάτων
Τρόποι εμφάνισης

Δικαιώματα - Επιλογές
Δε μπορείτε να δημοσιεύσετε νέα μηνύματα
Δε μπορείτε να δημοσιεύσετε απαντήσεις
Δεν μπορείτε να επισυνάψετε αρχεία
Δεν μπορείτε να επεξεργαστείτε τα μηνύματα σας

Ο κώδικας ΒΒ είναι σε λειτουργία
Τα Smilies είναι σε λειτουργία
Ο κώδικας [IMG] είναι σε λειτουργία
Ο κώδικας HTML είναι εκτός λειτουργίας
Trackbacks are εκτός λειτουργίας
Pingbacks are εκτός λειτουργίας
Refbacks are εκτός λειτουργίας


Παρόμοια Θέματα

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
Cascading ComboBox Chris Access - Ερωτήσεις / Απαντήσεις 16 03-02-18 22:31
Ευρεία αναζήτηση σε Combobox intefix Access - Ερωτήσεις / Απαντήσεις 2 18-03-15 14:08
Combobox (NotList) gregory_m Visual Basic .NET 1 24-05-14 20:54
[VBA] ComboBox φίλτρο anestaki Excel - Ερωτήσεις / Απαντήσεις 15 17-02-14 22:22
Φίλτρο με ComboBox Χρήστος Access - Ερωτήσεις / Απαντήσεις 3 09-02-12 22:59


Η ώρα είναι 20:54.