noureddine70 قام بنشر نوفمبر 17, 2023 قام بنشر نوفمبر 17, 2023 السلام عليكم و رحمة الله و بركاته أسأل الله ان تكونوا كلكم بخير و جزاكم الله خيرا عندي ملف فيه يوزرفورم و جعلت فيه كود الترحيل و جعلت في الليبل Label1 يعد الارقام الناقصة الموجودة في العمود الاول من ورقة العمل المطلوب عند الترحيل و في حالة وجود ارقام ناقصة يعطيني في الكمبوبكس1 أصغر رقم ناقص و في حالة عدم وجود ارقام ناقصة يعطيني اكبر رقم في العمود الاول +1. Chiffre Manquant.xlsm
أفضل إجابة أ / محمد صالح قام بنشر نوفمبر 17, 2023 أفضل إجابة قام بنشر نوفمبر 17, 2023 عليكم السلام ورحمة الله وبركاته يمكنك تعديل الاجراء liste إلى هذا Sub Liste() Dim ws As Worksheet, Rng As Range, tmp As String, combval As String, lr As Integer, x As Long Set ws = ThisWorkbook.Worksheets("BD") '===============Remplir les N° dans la Liste AFT==================== lr = ws.Range("A" & Rows.Count).End(xlUp).Row Set Rng = ws.Range("A2:A" & lr) Me.ComboBox1.Clear Me.ComboBox1.List = Rng.Value '===============Trouver le N° AFT Maximal======================== For x = WorksheetFunction.Min(Rng) To WorksheetFunction.Max(Rng) + 1 If IsError(Application.Match(Val(x), Rng, 0)) Then tmp = tmp & IIf(tmp = Empty, Empty, "-") & x If combval = "" Then combval = x Me.ComboBox1.AddItem x End If End If Next x Me.ComboBox1.Value = combval Me.Label1.Caption = tmp End Sub بالتوفيق 2
noureddine70 قام بنشر نوفمبر 17, 2023 الكاتب قام بنشر نوفمبر 17, 2023 بارك الله و جزاك الله خيرا و معذرة ان أضيف على هذا الكود حتى يكتمل المطلوب Sub Liste() On Error Resume Next Dim ws As Worksheet, Rng As Range, tmp As String, combval As String, lr As Integer, x As Long Set ws = ThisWorkbook.Worksheets("BD") '===============Remplir les N° dans la Liste AFT==================== lr = ws.Range("A" & Rows.Count).End(xlUp).Row Set Rng = ws.Range("A2:A" & lr) Me.ComboBox1.Clear Me.ComboBox1.List = Rng.Value '===============Trouver le N° AFT Maximal======================== For x = WorksheetFunction.Min(Rng) To WorksheetFunction.Max(Rng) If IsError(Application.Match(Val(x), Rng, 0)) Then tmp = tmp & IIf(tmp = Empty, Empty, "-") & x If combval = "" Then combval = x Me.ComboBox1.AddItem x End If End If Next x Me.Label1.Caption = tmp If Me.Label1.Caption = "" Then Me.ComboBox1.Value = WorksheetFunction.Max(Rng) + 1 Else Me.ComboBox1.Value = combval End If End Sub
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.