اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

حركة الارقام

black-eagle

بواسطه black-eagle
في منتدى الاكسيل Excel

 مشاركة

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

black-eagle

black-eagle

قام بنشر
  • الكاتب
قام بنشر

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

الملف على أفضل مما يكون .. عمل متعوب عليه بارك الله بك

يعمل دون أخطاء الا ان وضعنا الفاصلة بين الارقام ,, يصبح في عالم أخر  :frown3: 

أرجو إن تسنا لك الوقت أن تنظر في هذا الملف مشكورا

 

sttp +FIN 1.rar

رابط هذا التعليق
شارك
black-eagle

black-eagle

قام بنشر
  • الكاتب
قام بنشر

السلام عيكم

اخواني هذا كود من ترتيب الاستاذ ناصر ..
أرجو من أحد الاخوة مساعدتي في ايجاد ناتج طرح L , H من قيم G ( السلسلة التي على اساسها يتحدد ال Up , Down ) 

Dim y1, y2, z, g, L, H
Sub dd()
Rw = 5
Y = Val(InputBox("ÈÑÌÇÁ ÇÏÎá ÞíãÉ step"))
clm = Val(InputBox("ÈÑÇÌÇÁ ÇÏÎÇá ÑÞã ÚãæÏ ÇáäÊíÌÉ"))
x = Cells(Cells.Rows.Count, clm).End(xlUp).Row
If Cells(Cells.Rows.Count, clm).End(xlUp).Row >= 5 Then
Range(Cells(5, clm), Cells(Cells(Cells.Rows.Count, clm).End(xlUp).Row, clm)).Clear
End If
endr = Cells(Cells.Rows.Count, 1).End(xlUp).Row
g = [B5]
y1 = g - Y
y2 = g + Y
L = g
H = g
For r1 = 5 To endr
d = DateSerial(Mid(Cells(r1, 1), 1, 4), Mid(Cells(r1, 1), 6, 2), Mid(Cells(r1, 1), 9, 2))
d1 = Format(d, "dddd")
d2 = Cells(r1, 1)
d = Cells(r1, 1)
If Cells(r1, 2) < L Then L = Cells(r1, 2) //////// هنا
If Cells(r1, 2) > H Then H = Cells(r1, 2) //////// هنا
1:
If check(Cells(r1, 2)) = 1 Then
Cells(r2 + 5, clm) = "down" & String(z1, "+")
Cells(r2 + 5, clm).AddComment
Cells(r2 + 5, clm).Comment.Visible = False
fom = IIf(IIf(H <> 0, H, hh) < g, "no", IIf(Round((IIf(H <> 0, H, hh) - 100) / Y) = (IIf(H <> 0, H, hh) - 100) / Y, "no", IIf(H <> 0, H, hh)))
Cells(r2 + 5, clm).Comment.Text Text:="Author:" & Chr(10) & "Date : " & d1 & " " & Chr(10) & "          " & d2 & "" & Chr(10) & "Highest : " & fom & " " & Chr(10) & ""
If H <> 0 Then hh = H ////////// هنا
H = 0
r2 = r2 + 1
g = g - Y
y1 = g - Y
y2 = g + Y
z1 = 0
z2 = 0
If Cells(r1, 2) <= y1 Then
z1 = 1
GoTo 1
End If
ElseIf check(Cells(r1, 2)) = 2 Then
Cells(r2 + 5, clm) = "up" & String(z2, "+")
Cells(r2 + 5, clm).AddComment
Cells(r2 + 5, clm).Comment.Visible = False
fom2 = IIf(IIf(L <> 999999, L, ll) > g, "no", IIf(Round((IIf(L <> 999999, L, ll) - 100) / Y) = (IIf(L <> 999999, L, ll) - 100) / Y, "no", IIf(L <> 999999, L, ll)))
Cells(r2 + 5, clm).Comment.Text Text:="Author:" & Chr(10) & "Date : " & d1 & " " & Chr(10) & "          " & d2 & "" & Chr(10) & "Lowest : " & fom2 & " " & Chr(10) & ""
If L <> 999999 Then ll = L /////////// هنا
L = 999999
r2 = r2 + 1
g = g + Y
y1 = g - Y
y2 = g + Y
z1 = 0
z2 = 0

If Cells(r1, 2) >= y2 Then
z2 = 1
GoTo 1
End If
End If
Next
End Sub

Function check(x)
If x <= y1 Then
check = 1
ElseIf x >= y2 Then
check = 2
ElseIf x > y1 And x < y2 Then
check = 3
End If
End Function

اريد طرح H و L من القيم G لتظهر لدي قيم ال Highest و Lowest في خانة الكومنت 

رابط هذا التعليق
شارك
black-eagle

black-eagle

قام بنشر
  • الكاتب
قام بنشر

السلام عيكم

اخواني هذا كود من ترتيب الاستاذ ناصر ..

أرجو من أحد الاخوة مساعدتي في ايجاد ناتج طرح L , H من قيم G ( السلسلة التي على اساسها يتحدد ال Up , Down ) 

Dim y1, y2, z, g, L, H
Sub dd()
Rw = 5
Y = Val(InputBox("ÈÑÌÇÁ ÇÏÎá ÞíãÉ step"))
clm = Val(InputBox("ÈÑÇÌÇÁ ÇÏÎÇá ÑÞã ÚãæÏ ÇáäÊíÌÉ"))
x = Cells(Cells.Rows.Count, clm).End(xlUp).Row
If Cells(Cells.Rows.Count, clm).End(xlUp).Row >= 5 Then
Range(Cells(5, clm), Cells(Cells(Cells.Rows.Count, clm).End(xlUp).Row, clm)).Clear
End If
endr = Cells(Cells.Rows.Count, 1).End(xlUp).Row
g = [B5]
y1 = g - Y
y2 = g + Y
L = g
H = g
For r1 = 5 To endr
d = DateSerial(Mid(Cells(r1, 1), 1, 4), Mid(Cells(r1, 1), 6, 2), Mid(Cells(r1, 1), 9, 2))
d1 = Format(d, "dddd")
d2 = Cells(r1, 1)
d = Cells(r1, 1)
If Cells(r1, 2) < L Then L = Cells(r1, 2) //////// هنا
If Cells(r1, 2) > H Then H = Cells(r1, 2) //////// هنا
1:
If check(Cells(r1, 2)) = 1 Then
Cells(r2 + 5, clm) = "down" & String(z1, "+")
Cells(r2 + 5, clm).AddComment
Cells(r2 + 5, clm).Comment.Visible = False
fom = IIf(IIf(H <> 0, H, hh) < g, "no", IIf(Round((IIf(H <> 0, H, hh) - 100) / Y) = (IIf(H <> 0, H, hh) - 100) / Y, "no", IIf(H <> 0, H, hh)))
Cells(r2 + 5, clm).Comment.Text Text:="Author:" & Chr(10) & "Date : " & d1 & " " & Chr(10) & "          " & d2 & "" & Chr(10) & "Highest : " & fom & " " & Chr(10) & ""
If H <> 0 Then hh = H ////////// هنا
H = 0
r2 = r2 + 1
g = g - Y
y1 = g - Y
y2 = g + Y
z1 = 0
z2 = 0
If Cells(r1, 2) <= y1 Then
z1 = 1
GoTo 1
End If
ElseIf check(Cells(r1, 2)) = 2 Then
Cells(r2 + 5, clm) = "up" & String(z2, "+")
Cells(r2 + 5, clm).AddComment
Cells(r2 + 5, clm).Comment.Visible = False
fom2 = IIf(IIf(L <> 999999, L, ll) > g, "no", IIf(Round((IIf(L <> 999999, L, ll) - 100) / Y) = (IIf(L <> 999999, L, ll) - 100) / Y, "no", IIf(L <> 999999, L, ll)))
Cells(r2 + 5, clm).Comment.Text Text:="Author:" & Chr(10) & "Date : " & d1 & " " & Chr(10) & "          " & d2 & "" & Chr(10) & "Lowest : " & fom2 & " " & Chr(10) & ""
If L <> 999999 Then ll = L /////////// هنا
L = 999999
r2 = r2 + 1
g = g + Y
y1 = g - Y
y2 = g + Y
z1 = 0
z2 = 0

If Cells(r1, 2) >= y2 Then
z2 = 1
GoTo 1
End If
End If
Next
End Sub

Function check(x)
If x <= y1 Then
check = 1
ElseIf x >= y2 Then
check = 2
ElseIf x > y1 And x < y2 Then
check = 3
End If
End Function

اريد طرح H و L من القيم G لتظهر لدي قيم ال Highest و Lowest في خانة الكومنت 

up

رابط هذا التعليق
شارك
الـعيدروس

الـعيدروس

قام بنشر
قام بنشر

السلام عليكم

 

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

 

 

كيف أطرح ال Highest و ال Lowest من القيمة G في خانة الكومنت

 

ملاحظ حسب ماتوصلتو اليه ان الخلية التي بها Highest تعتبر ليس لها قيمة الـ Lowest

والعكس برضه  فكيف بيكون الطرح ؟ 

رابط هذا التعليق
شارك
black-eagle

black-eagle

قام بنشر
  • الكاتب
قام بنشر

السلام عليكم

 

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

كيف أطرح ال Highest و ال Lowest من القيمة G في خانة الكومنت

 

ملاحظ حسب ماتوصلتو اليه ان الخلية التي بها Highest تعتبر ليس لها قيمة الـ Lowest

والعكس برضه  فكيف بيكون الطرح ؟ 

 

نعم الاستاذ الكريم أحمد أفادني خير افادة .. بارك الله به

بالنسبة لسؤالك .. فالقيمة Highest هي اعلى رقم بين قيمتين من السلسة  G ( أي قبل الوصول الى احد قيم G التالية )

و ال Lowest أصغر رقم بين قيمتين من G 

ما اريده هو طرح ال Highest من G

و طرح G من Lowest

و هذا الكود كاملا دون أخطاء

 

Dim y1, y2, z, g, L, H
Sub dd()
Rw = 5
Y = Val(InputBox("ÈÑÌÇÁ ÇÏÎá ÞíãÉ step"))
clm = Val(InputBox("ÈÑÇÌÇÁ ÇÏÎÇá ÑÞã ÚãæÏ ÇáäÊíÌÉ"))
x = Cells(Cells.Rows.Count, clm).End(xlUp).Row
If Cells(Cells.Rows.Count, clm).End(xlUp).Row >= 5 Then
Range(Cells(5, clm), Cells(Cells(Cells.Rows.Count, clm).End(xlUp).Row, clm)).Clear
End If
endr = Cells(Cells.Rows.Count, 1).End(xlUp).Row
g = [B5]
y1 = g - Y
y2 = g + Y
L = g
H = g
For r1 = 5 To endr
d = DateSerial(Mid(Cells(r1, 1), 1, 4), Mid(Cells(r1, 1), 6, 2), Mid(Cells(r1, 1), 9, 2))
d1 = Format(d, "dddd")
d2 = Cells(r1, 1)
d = Cells(r1, 1)
If Cells(r1, 2) < L Then L = Cells(r1, 2)
If Cells(r1, 2) > H Then H = Cells(r1, 2)
1:
If check(Cells(r1, 2)) = 1 Then
Cells(r2 + 5, clm) = "down" & String(z1, "+")
Cells(r2 + 5, clm).AddComment
Cells(r2 + 5, clm).Comment.Visible = False
fom = IIf(IIf(H <> 0, H, hh) < g, "no", IIf(Round((IIf(H <> 0, H, hh) - 100) / Y) = (IIf(H <> 0, H, hh) - 100) / Y, "no", IIf(H <> 0, H, hh)))
Cells(r2 + 5, clm).Comment.Text Text:="Author:" & Chr(10) & "Date : " & d1 & " " & Chr(10) & "          " & d2 & "" & Chr(10) & "Highest : " & fom & " " & Chr(10) & ""
If H <> 0 Then hh = H
H = 0
r2 = r2 + 1
g = g - Y
y1 = g - Y
y2 = g + Y
z1 = 0
z2 = 0
If Cells(r1, 2) <= y1 Then
z1 = 1
GoTo 1
End If
ElseIf check(Cells(r1, 2)) = 2 Then
Cells(r2 + 5, clm) = "up" & String(z2, "+")
Cells(r2 + 5, clm).AddComment
Cells(r2 + 5, clm).Comment.Visible = False
fom2 = IIf(IIf(L <> 999999, L, ll) > g, "no", IIf(Round((IIf(L <> 999999, L, ll) - 100) / Y) = (IIf(L <> 999999, L, ll) - 100) / Y, "no", IIf(L <> 999999, L, ll)))
Cells(r2 + 5, clm).Comment.Text Text:="Author:" & Chr(10) & "Date : " & d1 & " " & Chr(10) & "          " & d2 & "" & Chr(10) & "Lowest : " & fom2 & " " & Chr(10) & ""
If L <> 999999 Then ll = L
L = 999999
r2 = r2 + 1
g = g + Y
y1 = g - Y
y2 = g + Y
z1 = 0
z2 = 0

If Cells(r1, 2) >= y2 Then
z2 = 1
GoTo 1
End If
End If
Next
End Sub

Function check(x)
If x <= y1 Then
check = 1
ElseIf x >= y2 Then
check = 2
ElseIf x > y1 And x < y2 Then
check = 3
End If
End Function
رابط هذا التعليق
شارك

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

  I accept