عكس القيم في عمود أوقلب النتائج في عمود مجاور (موضوع الأسبوع الثالث)

[الجموعي]

عن طريقة المعادلة

OFFSET

=OFFSET($A$6;-(ROW(A1)-1);0)

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

أجمل وأجمل يا أخي الغالي ..

بارك الله فيك وجزاك الله كل خير على هذه المساهمات الرائعة بحق

واااااصل معنا بلا فواصل

[جمال جبريل]

في ١٨‏/٣‏/٢٠١٦ at 10:10, محمد حسن المحمد said:

السلام عليكم ورحمة الله وبركاته

أساتذتي الكرام ...أخي الحبيب أبو البراء جزاكم الله خيراً على ما تتفضلون به من أعمال تنهض بحركة الفكر العربي "البرمجي"

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

عكس القيم :

1- نكتب القيم التي نريد في العمود A من A1:A6

2- ننسخها إلى العمود B من B1:B6

3- نكتب في موديول الكود التالي:

Sub FlipColumns()
Dim Rng As Range
Dim WorkRng As Range
Dim Arr As Variant
Dim i As Integer, j As Integer, k As Integer
On Error Resume Next
xTitleId = "عكس القيم"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("المدى", xTitleId, WorkRng.Address, Type:=8)
Arr = WorkRng.Formula
For j = 1 To UBound(Arr, 2)
    k = UBound(Arr, 1)
    For i = 1 To UBound(Arr, 1) / 2
        xTemp = Arr(i, j)
        Arr(i, j) = Arr(k, j)
        Arr(k, j) = xTemp
        k = k - 1
    Next
Next
WorkRng.Formula = Arr
End Sub

4- نضغط F5 أو Run من يطلب تحديد المدى وهنا من  B$1:$b$6 $ ثم موافق فنحصل على النتيجة المقاربة لطلبكم الكريم.

والسلام عليكم ورحمة الله وبركاته.

 

عكس القيم.rar

نريدها ما تم عمله من يمين الي اليسار او العكس ، وليس من اعلي الي اسفل او العكس

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

أخي الكريم جمال الخطيب

تعرف أنني أفضل طرح الطلبات في موضوعات جديدة لأن المشاركات الفرعية لا يلتفت إليها عادةً والدليل أن الطلب من 4 يونيو ونحن اليوم 20 يونيو أي مر 16 يوم بدون رد واحد على مشاركتك

عموماً جرب الكود التالي عله يفي بالغرض إن شاء المولى

Sub Flip_Columns()
    Dim Rng As Range, WorkRng As Range
    Dim I As Integer, J As Integer, K As Integer
    Dim xTitleId As String
    Dim Arr As Variant, xTemp As Variant
    
    On Error Resume Next
    xTitleId = "عكس القيم"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("المدى", xTitleId, WorkRng.Address, Type:=8)
    Arr = WorkRng.Formula

    For J = 1 To UBound(Arr, 2)
        K = UBound(Arr, 2)

        For I = 1 To UBound(Arr, 2) / 2
            xTemp = Arr(J, I)
            Arr(J, I) = Arr(J, K)
            Arr(J, K) = xTemp
            K = K - 1
        Next I
    Next J

    WorkRng.Formula = Arr
End Sub

تقبل تحياتي