أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
EM_ACC مجدى يونس-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة بحاجة الى كود ترحيل اكسيل اسئله واجابات


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





كود استيراد بيانات

عندى ملف بامتداد csv عملت على استخراج البيانات منه ووضعها بشكل افقى وتمت العمليه وعندما نسخت الملف خمس مرات ووضعته فى م ..



29-06-2020 04:08 مساء
احمد2004
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 31-12-2017
رقم العضوية : 2958
المشاركات : 27
الجنس : ذكر
تاريخ الميلاد : 22-12-1978
يتابعهم : 2
يتابعونه : 1
قوة السمعة : 55
 offline 

عندى ملف بامتداد csv  عملت على استخراج البيانات منه ووضعها بشكل افقى وتمت العمليه وعندما نسخت الملف خمس مرات ووضعته فى ملف وعدلت الكود لاستراد البينات وترتيبها يشكل افقى من الخمس ملفات اصبح الكود لا يعمل والمطلوب جمع البيانات وترتيبها فى ملف اكسيل بهذا الشكل
00:00 37.2 5.51 49.80%
01:00 37.2 5.51 49.80%
02:00 37.2 5.51 49.80%
03:00 37.2 5.51 49.80%
04:00 37.2 5.51 49.80%
05:00 37.2 5.51 49.80%
وهذا الكود الذى استخدمته




Sub Collectdata()
Dim w As Worksheet, i As Integer, k As Integer
Dim Folder As String, FileName As String, d As String, arr() As String
Dim aWB As Workbook, tWB As Workbook
Dim nr As Integer
Dim S As String

Set tWB = ThisWorkbook



Folder = "C:UsersahDesktopmonth ek3A 3importdata"
FileName = Dir(Folder & "*.csv")
k = 1
Do
Workbooks.Open Folder & "" & FileName
Set aWB = ActiveWorkbook
For Each w In Worksheets

nr = WorksheetFunction.CountA(Columns("a:a"))
ReDim arr(3 To nr)
For i = 3 To nr
S = Range("a" & i)
arr(i) = Mid(S, InStr(S, ",") + 1)
Next
d = Join(arr())
Dim wr() As Variant

wr() = Split(d, " ")

tWB.Worksheets("sheet1").Range("a&k:i&k").Value = wr
k = k + 1

Next
aWB.Close savechanges:=False
FileName = Dir
Loop Until FileName = ""
End Sub

 
 
 
 
  import data.rar   تحميل rar مرات التحميل :(3)
الحجم :(1.119) KB





الكلمات الدلالية
بيانات ، استيراد ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 07:21 صباحا