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

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

قام بنشر

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

تحويل.png

بيانات.xlsx

  • أفضل إجابة
قام بنشر
Sub Test()
    Dim a, vArray(), sOut As String, i As Long, ii As Long, k As Long
    Application.ScreenUpdating = False
        a = Range("A2").CurrentRegion.Value
        ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 1)
        For i = LBound(a, 1) To UBound(a, 1)
            For ii = LBound(a, 2) To UBound(a, 2)
                k = k + 1
                b(k, 1) = a(i, ii)
            Next ii
        Next i
        Columns("G").ClearContents
        Range("G2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
        vArray = Application.Transpose(b)
        sOut = Join(vArray, vbCrLf)
        Open ThisWorkbook.Path & "\Output.txt" For Output As #1
        Print #1, sOut
        Close #1
    Application.ScreenUpdating = True
    MsgBox "Done...", 64, "LionHeart"
End Sub

 

  • Like 4
قام بنشر

ممكن خيار آخر؟ بعد اذنكم

Sub test2()
Dim a As Variant
Dim i As Long
    a = Cells(2.1).CurrentRegion
    Columns("H").ClearContents
    For i = 2 To UBound(a)
        Cells(Cells(Rows.Count, 8).End(xlUp).Row + 1, 8).Resize(4) = Application.Transpose(Application.Index(a, i, Array(1, 2, 3, 4)))
    Next
End Sub

Sub test2()
    Dim a As Variant
    Dim i As Long
    Columns("H").ClearContents
    a = Cells(2.1).CurrentRegion
    For i = 2 To UBound(a)
        b = IIf(b <> "", b & vbCrLf & Join(Application.Index(a, i, x), vbCrLf), _
                Join(Application.Index(a, i, Application.Transpose(Evaluate("row(1:" & UBound(a, 2) & ")"))), vbCrLf))
    Next
    Cells(2, 9).Resize((UBound(a) - 1) * UBound(a, 2)) = Application.Transpose(Split(b, vbCrLf))
    Open ThisWorkbook.Path & "\MOutput.txt" For Output As #1
    Print #1, b
    Close #1
End Sub

 

  • Like 3

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information