طلب تعديل مجموعة خلايا في عمود ما الى شكل اخر

[اوفيس 2003]

لدي كل يوم سيرفرات اكثر من 250 سيرفر للستالايت ولكني اريد نقلها مباشرة بشكل معين حتى اضعهم في ملف تكست مباشرة مرقف ملف فيه شرح مااريد بالتفصيل

Q.rar

[جمال عبد السميع]

أتمني أن يكون المطلوب

إختيار السيرفر.rar

[اوفيس 2003]

اشكرك على الرد والمتابعة ياغالي

ولكني اريد تعديل الخلايا الموجودة في العمود الأول A1 بالشكل الموجود وارفقته في المثال

[جمال عبد السميع]

أتمني أخي أن يكون المطلوب

وإذا لم يكن هو المطلوب ماهي الحكمة من وجودهم في سطرين ؟

إختيار السيرفر 2.rar

إختيار السيرفر 4.rar

تم تعديل أكتوبر 27, 2012 بواسطه mahmoud-lee

[جمال عبد السميع]

لقد قمت بالنسخ من البرنامج إلي ملف ( text ) وهذا هو الدليل كما هو موجود في مرفقك

إختيار سيرفر.rar

[اوفيس 2003]

اسف لتعبك معي

بس انا مش فاهم ماقمت بعمله الله يبارك فيك

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

اتمنى تكون فهمتني

[الـعيدروس]

السلام عليكم

حسب فهمي للطلب

اولا في هذا السطر حط مسار ملف Text قبل تنفيذ الكود

Ali_Path = "C:\Ali\gg.txt"

وهذا الكود في مودويل

Public Sub ali_T()

Dim r As Range, A, Ali_Path$

Str_A = "[Serv_"

[B1].ColumnWidth = 64.15

  Rt = 1

  Ali_Path = "C:\Ali\gg.txt"

'***************************************

'  C:\Ali\gg.txt المسار

' غيره حسب مسار ملف التكست والمسمى

Open Ali_Path For Output As #1

'***************************************

With Application

.ScreenUpdating = False

.EnableEvents = False

For Each r In Range("A1:A256")

   If Not IsEmpty(r) Then

	 A = Str_A & Rt & "]" & Chr(10) & r.Text & Chr(10) _

	  & "." & Chr(10) & "." & Chr(10) & Str_A & Rt & "]" & Chr(10) & r.Text

	  Cells(Rt, 2) = A

	   Print #1, Str_A & Rt & "]" & vbCrLf & r.Text & vbCrLf & "." & vbCrLf _

	    & "." & vbCrLf & Str_A & Rt & "]" & vbCrLf & r.Text & vbCrLf

	  Rt = Rt + 1

   End If

Next

.ScreenUpdating = True

.EnableEvents = True

End With

Close #1

End Sub

الكود ينسخ بيانات العمود A ويضيف عليها ماطلبت وينسخها الى ملف Text المشار اليه بالمسار اول الكود

و في العمود B

[اوفيس 2003]

مشكور اخي على الله يبارك فيك

وصلت تقريباً لما اريد الله يبارك فيك

ولكن الشكل ياغالي اللي اريده ليس كما ظهر في الناتج في ملف التكست ، والله واضح جدا في سؤالي

هذا الموجود

C: cccam.satlover.com 31080 EB088DD2_3E4810DF www.satlover.com

وانا اريده

[serv_1]

server=CCCam:satlover.com:31080:0:84483D35_F892057E:www.satlover.com

فقط لاحظ سطرين لا اكثر ياغالي وبعدهم مباشرة السيرفر التالي ، ولاحظ ياغالي العلامات بين الكلام هذه : ولاحظ ايضا :0: هؤلاء غير موجودين في المدخل

[اوفيس 2003]

منتظر إجابتك اخي على الغالي

[الـعيدروس]

السلام عليكم

تفضل جرب الكود بعد التعديل

ولاتنسى مسار ملف الـ Text

Public Sub ali_T()

Dim r As Range, A, Ali_Path$

Str_A = "[Serv_"

[B1].ColumnWidth = 64.15

  Rt = 1

  Ali_Path = "C:\Ali\gg.txt"

'***************************************

'  C:\Ali\gg.txt المسار

' غيره حسب مسار ملف التكست والمسمى

Open Ali_Path For Output As #1

'***************************************

With Application

.ScreenUpdating = False

.EnableEvents = False

For Each r In Range("A1:A256")

   If Not IsEmpty(r) Then

		 A = Str_A & Rt & "]" & Chr(10) & r.Text & Chr(10)

		  Cells(Rt, 2) = A

		   Print #1, Str_A & Rt & "]" & vbCrLf & r.Text & vbCrLf

		  Rt = Rt + 1

   End If

Next

.ScreenUpdating = True

.EnableEvents = True

End With

Close #1

End Sub

[اوفيس 2003]

مشكور ياغالي واعتذر عن تعبك معي

ولكن نفس المشكلة لاحظ الفرق بين السطرين ياغالي جيداً

[الـعيدروس]

السلام عليكم

تفضل

Public Sub ali_T()

Dim r As Range, A, Ali_Path$

Str_A = "[Serv_"

[B1].ColumnWidth = 64.15

  Rt = 1

  Ali_Path = "C:\Ali\gg.txt"

'***************************************

'  C:\Ali\gg.txt المسار

' غيره حسب مسار ملف التكست والمسمى

Open Ali_Path For Output As #1

'***************************************

With Application

.ScreenUpdating = False

.EnableEvents = False

For Each r In Range("A1:A256")

At = Replace(r.Text, "C:", "server=")

   If Not IsEmpty(r) Then

				 A = Str_A & Rt & "]" & Chr(10) & At & Chr(10)

				  Cells(Rt, 2) = A

				   Print #1, Str_A & Rt & "]" & vbCrLf & At & vbCrLf

				  Rt = Rt + 1

   End If

Next

.ScreenUpdating = True

.EnableEvents = True

End With

Close #1

End Sub

[اوفيس 2003]

مافي اي تغيير نفس الموجود اعلاه ولم يتم تغيره الى المطلوب ياغالي ، تقريباً وضعت نفس الكود

[اوفيس 2003]

منتظر الرد ياغالي

[اوفيس 2003]

للرفـــــــــــــــــع

[الـعيدروس]

السلام عليكم

جرب هذا التعديل امل ان يكون المطلوب

والسموحه منك سهيت عن موضوعك

Public Sub ali_T()

Dim r As Range, A, Ali_Path$

Dim T_A, T_B, S_A

Str_A = "[Serv_"

[B1].ColumnWidth = 69

  Rt = 1

  Ali_Path = "C:\Ali\gg.txt"

'***************************************

'  C:\Ali\gg.txt المسار

' غيره حسب مسار ملف التكست والمسمى

Open Ali_Path For Output As #1

'***************************************

With Application

.ScreenUpdating = False

.EnableEvents = False

For Each r In Range("A1:A256")

At = Replace(r.Text, "C:", "server=")

   If Not IsEmpty(r) Then

	 A = Str_A & Rt & "]" & Chr(10) & At & Chr(10)

    T_A = Split(A, " ")

    T_B = Split(T_A(1), ".")

    S_A = T_A(0) & " " & T_B(0) & ":" & T_B(1) & "." & T_B(2) & ":" & T_A(2) & ":0:" & T_A(3) & ":" & T_A(4)

	 Cells(Rt, 2) = S_A

	 Print #1, Str_A & Rt & "]" & vbCrLf & S_A & vbCrLf

    Rt = Rt + 1

   End If

Next

.ScreenUpdating = True

.EnableEvents = True

End With

Close #1

End Sub

[اوفيس 2003]

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

بس لو سمحت كنت اريد منك تعديل بسيط

لا يوجد فراغ بين الأسطر في الملف التكست

يعني تكونبنفس الناتج اللي عملته اعلاه ولكن بدون فراغات بين السطر والثاني

[الـعيدروس]

تفضل

Public Sub ali_T()

Dim r As Range, A, Ali_Path$

Dim T_A, T_B, S_A

Str_A = "[Serv_"

[B1].ColumnWidth = 69

  Rt = 1

  Ali_Path = "C:\Ali\gg.txt"

'***************************************

'  C:\Ali\gg.txt المسار

' غيره حسب مسار ملف التكست والمسمى

Open Ali_Path For Output As #1

'***************************************

With Application

.ScreenUpdating = False

.EnableEvents = False

For Each r In Range("A1:A256")

At = Replace(r.Text, "C:", "server=")

   If Not IsEmpty(r) Then

		 A = Str_A & Rt & "]" & Chr(10) & At & Chr(10)

	    T_A = Split(A, " ")

	    T_B = Split(T_A(1), ".")

	    S_A = T_A(0) & " " & T_B(0) & ":" & T_B(1) & "." & T_B(2) & ":" & T_A(2) & ":0:" & T_A(3) & ":" & T_A(4)

		 Cells(Rt, 2) = S_A

		 Print #1, Str_A & Rt & "]" & vbCrLf & S_A

	    Rt = Rt + 1

   End If

Next

.ScreenUpdating = True

.EnableEvents = True

End With

Close #1

End Sub

[اوفيس 2003]

جزاك الله كل خير

وهو المطلوب ان شاء الله