الرجاء المساعدة في نقل وترحيل الحقول كما في المرفق

[Tarekfathallah]

السلام عليكم الرجاء المساعدة في ترحيل ونقل الحقول كما في الملف المرفق 

---------------------    للرفع -----------------------

M1_BKAWEST111.rar

[ياسر خليل أبو البراء]

وعليكم السلام

المطلوب غير واضح على الإطلاق .. حضرتك أرفقت ملف ووضعت الموضوع بدون أي حيثيات للمطلوب ولا يوجد شكل للنتائج المتوقعة ..

أرى موضوع آخر لك لم تجد استجابة فيه ربما لنفس السبب أخي الكريم طارق

حاول توضح المطلوب في الموضوع وتحدث بلغة الإكسيل لكي يفهمك الجميع ويحاولون تقديم المساعدة المطلوبة

[Tarekfathallah]

استاذنا ياسر ادامك الله وشكرا للرد 

المطلوب هو نقل المحافظة والقضائ والبلدة او الحي وطائفة اللائحة والجنس من سطر الى عمود كما في المرفق السطر سجل من رقم 1 الى السجل رقم   1371   انظر اليه 

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

ملاحظة الانتباه الى وجود عدة اقضية وعدة من البلدة والحي وطائفة اللائحة والجنس 

--------------------   للرفع ----------------------

اخي واستاذنا القاعدة كبيرة والملفات كثيرة حوالي 15 ملف اكسيل 

لاحظ اللاسطر باللون الازرق للمحي والاسطر باللون الاحمر للترحيل الى الاعمدة التابعة لها الى يمين الجداول G H I J K L 

 

M1_BKAWEST111.rar

تم تعديل يوليو 22, 2017 بواسطه tarek_f26180

[ياسر خليل أبو البراء]

بعد محاولة فهم المطلوب .. إليك الكود التالي عله يفي بالغرض

قم أولاً في الملف المرفق الأخير بتسمية الشيت باسم Sheet1 وأنشيء ورقة عمل جديدة باسم Sheet2 .. ثم نفذ الكود التالي .. والنتائج ستكون منفصلة في ورقة العمل Sheet2

Sub TestArrays()
    Dim arr         As Variant
    Dim temp        As Variant
    Dim x           As Variant
    Dim b           As Boolean
    Dim f           As Boolean
    Dim str         As String
    Dim i           As Long
    Dim j           As Long
    Dim k           As Long
    
    With Sheets("Sheet1")
        arr = .Range("A1:L" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
    End With
    ReDim temp(1 To UBound(arr, 1), 1 To UBound(arr, 2))

    For i = LBound(arr, 1) To UBound(arr, 1)
        If InStr(arr(i, 1), "محافظة") > 0 And b = False Then
            For j = 1 To 5
                str = str & "," & CStr(arr(i + 1, j))
            Next j

            b = True
            i = i + 3
            k = k + 1

            For j = LBound(arr, 2) To 7
                temp(k, j) = CStr(arr(i, j))
            Next j
            x = Split(Mid(str, 2), ",")
            For j = LBound(x) To UBound(x)
                temp(k, j + 8) = x(j)
            Next j
            b = False: f = True: str = ""
        Else
            If b = False And f = False Then
                k = k + 1
                For j = LBound(arr, 2) To UBound(arr, 2)
                    temp(k, j) = CStr(arr(i, j))
                Next j
            ElseIf b = False And f = True Then
                k = k + 1
                For j = LBound(arr, 2) To 7
                    temp(k, j) = CStr(arr(i, j))
                Next j
                For j = 8 To 12
                    temp(k, j) = temp(k - 1, j)
                Next j
            End If
        End If
    Next i

    Sheets("Sheet2").Range("A1").Resize(UBound(temp, 1), UBound(temp, 2)).Value = temp

    MsgBox "Done...", 64
End Sub

 

[Tarekfathallah]

السلام عليك اخ ي واستاذنا ياسر 100/100 الله يفتح عليك ويرفع درجاتك 

------------------   للرفع --------------

[ياسر خليل أبو البراء]

وعليكم السلام ...

لقد احترت في الموضوع .. ولم أفهم هل تم حل الموضوع أم لا بهذا الشكل

حيث أنك قمت بالرد بعد وضع الكود وشرحت بنفس الطريقة تماماً فلا يوجد جديد .. والكود المقدم حسب ما فهمت 

فإذا كان الأمر مختلف أو الموضوع مختلف يرجى مزيد من التوضيح ويرجى عدم وضع الملف الأصلي بل يوضع نموذج مصغر لكي تستطيع الشرح عليه بشكل أفضل وحتى يكون أيسر لمن يريد تقديم المساعدة

واعلم أن حل أي مشكلة يمثل فهم المشكلة 90% من حلها لذا يجب التوضيح والقاء الضوء أكثر على شكل النتائج المتوقعة ..

لقد استغرق الكود مني بالأمس أكثر من ساعة ونصف وللأسف يبدو أنه لا يلبي طلبك ... لذا سأترك الموضوع لإخواني الكرام لربما يفهمون المطلوب أكثر مني ويستطيعون تقديم المساعدة المطلوبة

تقبل تحياتي

[Tarekfathallah]

اخي اسر اعطيتني المطلوب بالظبط شكرا لك وادامك الله 

ولكن هل يمكنك مساعدتي في طلبي 

--------------   للرفع ----------------

[ياسر خليل أبو البراء]

الحمد لله الذي بنعمته تتم الصالحات

في الحقيقة اطلعت على الموضوع وليس لي علم به .. لربما يفيدك أحد الأخوة

أو لربما لو وضعت نموذج مصغر مع التوضيح بشكل آخر يكون أفضل ..حاول عدم وضع الملفات الأصلية في الموضوعات ..اكتفي بجزء بسيط لتستطيع التوضيح أكثر عليه

وفقك الله ..