اذهب الي المحتوي
أوفيسنا

طلب مساعدة


إذهب إلى الإجابة الإجابة بواسطة محي الدين ابو البشر,

الردود الموصى بها

  • تمت الإجابة
قام بنشر

وعليكم السلام والرحمة

ربما

Sub test()
Dim a, w, x, k
Dim i&, ii&
    a = Cells(1).CurrentRegion
    With CreateObject("scripting.dictionary")
        For i = 5 To UBound(a)
            If Not .exists(a(i, 9)) Then
                .Add a(i, 9), Array(a(i, 9), a(i, 2), a(i, 3) & "\" & a(i, 4), "SP" & a(i, 5) & " PORT " & Format(a(i, 6), "0#"), "TB Number " & Format(a(i, 7), "0#"))
            Else
                w = .Item(a(i, 9))
                x = Split(w(3), "-")
                If UBound(x) > 0 Then
               w(3) = x(0) & "- " & Format(a(i, 6), "0#")
                .Item(a(i, 9)) = w
                Else
                x(UBound(x)) = x(UBound(x)) & " -" & Format(a(i, 6), "0#")
                w(3) = Join(x)
                .Item(a(i, 9)) = w
            End If: End If
        Next
       For Each k In .keys
       Cells(5 + ii, 13).Resize(5) = Application.Transpose(.Item(k))
       ii = ii + 6
       Next
    End With
End Sub

 

  • Like 1
قام بنشر

شكرا اخى

 هل ممكن تطبيقه على الملف المرسل سابقا واعادة ارسال الملف

شكرا استاذ محى الدين - يعمل بامتياز ولكن لى تعديل بسي' جدا لو امكن , فضل كرمك 

تم اضافة عمود يحتوى على ODB  و TB  فمحتاج يقرا اللى مكتوب فى العمود ده  ويضعا مكان ال Tb Number 

مثل الملف المرفق 

كما احتاج يكون التنسيق كم بالملف المرفق

شكرا لمجهودك وتعبك - جعله الله فى ميزان حسناتك

 

GRANITE.xlsx

قام بنشر

تفضل أخي الكريم

Sub test()
Dim a, w, x, k
Dim i&, ii&
    a = Cells(1).CurrentRegion
    With CreateObject("scripting.dictionary")
        For i = 5 To UBound(a)
            If Not .exists(a(i, 9)) Then
                .Add a(i, 9), Array(a(i, 9), a(i, 2), a(i, 3) & "\" & a(i, 4), "SP" & a(i, 5) & " PORT " & Format(a(i, 6), "0#"), a(i, 10) & " NO -  " & Format(a(i, 7), "0#"))
            Else
                w = .Item(a(i, 9))
                x = Split(w(3), "-")
                If UBound(x) > 0 Then
               w(3) = x(0) & "- " & Format(a(i, 6), "0#")
                .Item(a(i, 9)) = w
                Else
                x(UBound(x)) = x(UBound(x)) & " -" & Format(a(i, 6), "0#")
                w(3) = Join(x)
                .Item(a(i, 9)) = w
            End If: End If
        Next
       For Each k In .keys
       Cells(5 + ii, 14).Resize(5) = Application.Transpose(.Item(k))
       ii = ii + 6
       Next
    End With
End Sub

 

  • Like 3
قام بنشر

الف الف شكرا استاذ محى الدين على المجهود الجبار - يعمل بامتياز 

بس كرما بعد اذنك - لاحظت ان لو رقم ال tb  ثابت مع عدد 2 سبلتر - المعادلة بتقرا البورت  المقابل من سبلتر  1  وبتنهى بالبورت المقابل  فى سبلتر 2 دون تغيير السبلتر

مرفق الملف - ارجوا تعديل المعادلات لتتناسب مع الايضاح الملون بالملف

GRANITE-Macro.xlsm

  • 1 month later...
  • 2 months later...

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information