دستور اضافه شدن یک شیت خاص با اضافه شدن یک سطر

**ali65e** · 2013/12/23, 17:39

سلام مجدد خدمت دوستان خوبم
دوستان تا این جا خداروشکر به لطف کمک های شما دوستان عزیز جلو رفتم ولی متاسفانه نمی دانم چرا این مشکلات تمامی نداره و هر چی جلوتر میرم با مشکلات جدیدتری مواجه میشم که باز منو مجبور می کنه علارقم میل باطنیم مزاحم شما ببشم.
دوستان تا این جا تونستیم با کمک دوستان ماکرویی بسازیم که شیت هایی هم نام با داده های یکی از ستون ها(ستون نام ونام خانوادگی دانش آموز) بسازیم .دوستان مشکلی که در حال حاضر با آن مواجه شدم اینه که می خوام داده های یک سلول خاص که حاوی معدل دانش آموز است را با معدل دیگر دانش آموزان که در سلول مشابه همین سلول در دیگر شیت های قرار دارد را، مقایسه کنم و در انتها رتبه دانش آموز در یکی از سلول های هر شیت درج بشه.
دوستان متن ماکرویی که شیت ها رو می سازه رو خدمتتون میذارم که تونسته باشم بهتر منظورمو برسونم
Sub sheetnaming()
Sheets("Sheet2").Select
c = Range("I11").Value
For e = 2 To c + 1
Name = Range("G" & e).Value
Sheets("Sheet20").Select
Sheets("Sheet20").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Name
ActiveSheet.Range("a1") = Name
Sheets("Sheet2").Select
ActiveSheet.Hyperlinks.Add Anchor:=Range("G" & e), Address:="", SubAddress:=Name & "!A1", TextToDisplay:=Name

Range("G2:G40").Select
With Selection.Font
.Name = "B Nazanin"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Underline = xlUnderlineStyleNone
With Selection.Font
.Color = -10477568
.TintAndShade = 0
End With
With Selection.Font
.Color = -10477568
.TintAndShade = 0
End With
Next e
End Sub

**Amir Ghasemiyan** · 2013/12/23, 18:50

نوشته اصلی توسط ali65e

سلام مجدد خدمت دوستان خوبم
دوستان تا این جا خداروشکر به لطف کمک های شما دوستان عزیز جلو رفتم ولی متاسفانه نمی دانم چرا این مشکلات تمامی نداره و هر چی جلوتر میرم با مشکلات جدیدتری مواجه میشم که باز منو مجبور می کنه علارقم میل باطنیم مزاحم شما ببشم.
دوستان تا این جا تونستیم با کمک دوستان ماکرویی بسازیم که شیت هایی هم نام با داده های یکی از ستون ها(ستون نام ونام خانوادگی دانش آموز) بسازیم .دوستان مشکلی که در حال حاضر با آن مواجه شدم اینه که می خوام داده های یک سلول خاص که حاوی معدل دانش آموز است را با معدل دیگر دانش آموزان که در سلول مشابه همین سلول در دیگر شیت های قرار دارد را، مقایسه کنم و در انتها رتبه دانش آموز در یکی از سلول های هر شیت درج بشه.
دوستان متن ماکرویی که شیت ها رو می سازه رو خدمتتون میذارم که تونسته باشم بهتر منظورمو برسونم

سلام دوست عزيز.
كاري كه شما ميخواين يكم پيچيده شده. شما بايد از همچين كدي استفاده كنيد

کد:

Sub ranking() Dim s(3) As String Dim q(3) As String Sheets("Sheet1").Select For i = 0 To 3 s(i) = Range("A1").Value ActiveSheet.Next.Select Next i Sheets("Sheet1").Select For i = 0 To 3 Range("G" & i + 1) = s(i) Next i For i = 0 To 3 q(i) = Range("H" & i + 1).Value Next i Sheets("Sheet1").Select For i = 0 To 3 ActiveSheet.Next.Select Range("A2").Value = q(i) Next i End Sub

منتها شما نياز دارين كه در sheet 1 در ستون H اين دستور رو وارد كنيد و براي مثلا 100 سلول بسط بدين

کد:

=RANK(G1;$G:$G)

**ali65e** · 2013/12/23, 19:13

سلام.
امیر جان معدل ها توو سلول bi122 شیت ها قرار داره.شماره ی سلول رو کجای تابع بنویسم؟امیر جان بعد از این که این ماکرو انجام بشه، رتبه دانش آموزان کجا نوشته میشه؟

**Amir Ghasemiyan** · 2013/12/23, 19:25

نوشته اصلی توسط ali65e

سلام.
امیر جان معدل ها توو سلول bi122 شیت ها قرار داره.شماره ی سلول رو کجای تابع بنویسم؟امیر جان بعد از این که این ماکرو انجام بشه، رتبه دانش آموزان کجا نوشته میشه؟

سلام دوست عزيز
اين خط رو اصلاح كنيد و بجاي A1 همون BI122 رو بذارين (خط 6)

کد:

s(i) = Range("A1").Value

رتبه دانش آموزان تو سلول A2 هر شيت نوشته ميشه (خط 19)

**ali65e** · 2013/12/23, 20:41

امیر خان یه جایه کار میلنگه داداش.
من ماکرو رو اونجوری که گفتی تغییر دادم ولی ارور میده
Sub ranking()
Dim s(3) As String
Dim q(3) As String
Sheets("Sheet1").Select
For i = 0 To 3
s(i) = Range("bi122").Value
ActiveSheet.Next.Select
Next i
Sheets("Sheet1").Select
For i = 0 To 3
Range("G" & i + 1) = s(i)
Next i

For i = 0 To 3
q(i) = Range("H" & i + 1).Value
Next i
Sheets("Sheet1").Select
For i = 0 To 3
ActiveSheet.Next.Select
Range("A2").Value = q(i)
Next i

End Sub
داداش اون قسمت ماکرو که رنگی کردم ،اکسل براش debug میخواد.

**Amir Ghasemiyan** · 2013/12/23, 22:39

نوشته اصلی توسط ali65e

امیر خان یه جایه کار میلنگه داداش.
من ماکرو رو اونجوری که گفتی تغییر دادم ولی ارور میده
Sub ranking()
Dim s(3) As String
Dim q(3) As String
Sheets("Sheet1").Select
For i = 0 To 3
s(i) = Range("bi122").Value
ActiveSheet.Next.Select
Next i
Sheets("Sheet1").Select
For i = 0 To 3
Range("G" & i + 1) = s(i)
Next i

For i = 0 To 3
q(i) = Range("H" & i + 1).Value
Next i
Sheets("Sheet1").Select
For i = 0 To 3
ActiveSheet.Next.Select
Range("A2").Value = q(i)
Next i

End Sub
داداش اون قسمت ماکرو که رنگی کردم ،اکسل براش debug میخواد.

دوست عزيز شما در sheet1 در ستون H اون فرمولي كه دادم خدمتتون وارد كردين؟
درضمن لطف كنيد كدهاتون رو داخل تگ كد بذارين تا مرتب تر باشه و بهتر بشه خوند

**ali65e** · 2013/12/23, 23:00

امیر جان من حقیقتش کامل متوجه منظورتون نشدم که چطوری باید اون فرمولی رو که فرمودین رو در ستون h اعمال کنم!آیا اول باید روی کل ستون H کلیک کنم و سپس روی کل ستون پیست کنم یا اول باید روی سلول اول پیست کنم و سپس دوباره کپی بگیرم از روی سلول اول و بعد روی 100 سلول اول پیست کنم؟
چشم .از دفعه های بعد حتما این کاری رو که گفتید انجام میدم.

**Amir Ghasemiyan** · 2013/12/23, 23:21

نوشته اصلی توسط ali65e

امیر جان من حقیقتش کامل متوجه منظورتون نشدم که چطوری باید اون فرمولی رو که فرمودین رو در ستون h اعمال کنم!آیا اول باید روی کل ستون h کلیک کنم و سپس روی کل ستون پیست کنم یا اول باید روی سلول اول پیست کنم و سپس دوباره کپی بگیرم از روی سلول اول و بعد روی 100 سلول اول پیست کنم؟
چشم .از دفعه های بعد حتما این کاری رو که گفتید انجام میدم.

دومي كه گفتين

يعني تو سلول h1 شما همچين فرمولي دارين:

کد:

=rank(g1;$g:$g)

تو سلول h2 اين فرمول رو خواهيم داشت:

کد:

=rank(g2;$g:$g)

و به همين ترتيب الي آخر.

چشمتونم بي بلا

**ali65e** · 2013/12/23, 23:59

امیر جان فایلشو میذارم خدمتتون ببینید.بازم ارور میده

فایل های پیوست شده

amir.xlsm (30.1 کیلو بایت, مشاهدات 11)

**Amir Ghasemiyan** · 2013/12/24, 01:12

نوشته اصلی توسط ali65e

امیر جان فایلشو میذارم خدمتتون ببینید.بازم ارور میده

بفرماييد خدمت شما. يكسري اصلاحات انجام دادم. الان زير هر معدل رتبه رو هم مشخص ميكنه

فایل های پیوست شده

amir.xlsm (31.2 کیلو بایت, مشاهدات 19)

**ali65e** · 2013/12/27, 10:05

سلام مجدد خدمت دوست و استاد گلم
امیر جان این تابعی که شما توو این فایل زحمت کشیده اید واسه وقت هایی که شیت ها ثابت هستند کاملا درست عمل می کنه ولی اگر شیت های ایجاد شده توسط ماکرو ایجاد شده باشند ،نرم افزار دی باگ می خواد.امیر جان فایلشو خدمتتون میذارم که بهتر تونسته باشم توضیح داده باشم.

فایل های پیوست شده

amir4.xlsm (25.3 کیلو بایت, مشاهدات 17)

**Amir Ghasemiyan** · 2013/12/27, 19:47

نوشته اصلی توسط ali65e

سلام مجدد خدمت دوست و استاد گلم
امیر جان این تابعی که شما توو این فایل زحمت کشیده اید واسه وقت هایی که شیت ها ثابت هستند کاملا درست عمل می کنه ولی اگر شیت های ایجاد شده توسط ماکرو ایجاد شده باشند ،نرم افزار دی باگ می خواد.امیر جان فایلشو خدمتتون میذارم که بهتر تونسته باشم توضیح داده باشم.

سلام مجدد دوست عزيز
فايل درست بود تقريبا. فكر كنم گفته بودم فايل نمونس و بايد اصلاح كنين. شايد هم نگفتم

اين كد اصلاح شده مطابق با فايلي كه الان گذاشتين

کد:

Sub ranking() Dim s(100) As String Dim q(100) As String Sheets("Sheet1").Select ActiveSheet.Next.Select c = Range("I11").Value ActiveSheet.Next.Select For i = 0 To c - 1 ActiveSheet.Next.Select s(i) = Range("Bi122").Value Next i Sheets("Sheet1").Select For i = 0 To c - 1 Range("G" & i + 1) = s(i) Next i For i = 0 To c - 1 q(i) = Range("H" & i + 1).Value Next i Sheets("Sheet1").Select ActiveSheet.Next.Select ActiveSheet.Next.Select For i = 0 To c - 1 ActiveSheet.Next.Select Range("BI123").Value = q(i) Next i End Sub

**ali65e** · 2013/12/27, 19:53

نوشته اصلی توسط amir ghasemiyan

سلام مجدد دوست عزيز
فايل درست بود تقريبا. فكر كنم گفته بودم فايل نمونس و بايد اصلاح كنين. شايد هم نگفتم

اين كد اصلاح شده مطابق با فايلي كه الان گذاشتين

کد:

Sub ranking() Dim s(100) As String Dim q(100) As String Sheets("Sheet1").Select ActiveSheet.Next.Select c = Range("I11").Value ActiveSheet.Next.Select For i = 0 To c - 1 ActiveSheet.Next.Select s(i) = Range("Bi122").Value Next i Sheets("Sheet1").Select For i = 0 To c - 1 Range("G" & i + 1) = s(i) Next i For i = 0 To c - 1 q(i) = Range("H" & i + 1).Value Next i Sheets("Sheet1").Select ActiveSheet.Next.Select ActiveSheet.Next.Select For i = 0 To c - 1 ActiveSheet.Next.Select Range("BI123").Value = q(i) Next i End Sub

ممنون داداش خوده خودشه.دمت گممممممممممممم

**ali65e** · 2013/12/29, 20:13

امیر جان جسارتا یه مارکو می خوام که اطلاعات سلول های a1 شیت هایی که ماکرویه قبلی به تعداد دانش آموزان ایجاد کرده رو با هم جمع کنه و حاصل جمعشو تو سلول مثلا b1 بنویسه.متن مارکوهایی که فایلم با اون کار می کنه رو خدمتتون میذارم
ماکرویه 1

کد:

Sub sheetnaming()
Sheets("Sheet2").Select
c = Range("I11").Value
For e = 2 To c + 1
    Name = Range("G" & e).Value
    Sheets("Sheet20").Select
    Sheets("Sheet20").Copy After:=Sheets(Worksheets.Count)
    ActiveSheet.Name = Name
    ActiveSheet.Range("a1") = Name
    Sheets("Sheet2").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Range("G" & e), Address:="", SubAddress:=Name & "!A1", TextToDisplay:=Name


    Range("G2:G40").Select
    With Selection.Font
        .Name = "B Nazanin"
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .Color = -10477568
        .TintAndShade = 0
    End With
    With Selection.Font
        .Color = -10477568
        .TintAndShade = 0
    End With
Next e
End Sub

ماکرویه 2

کد:

Sub oloom()


Dim s(100) As String
Dim q(100) As String
Sheets("Sheet1").Select
ActiveSheet.Next.Select
c = Range("I11").Value
ActiveSheet.Next.Select
For i = 0 To c - 1
    ActiveSheet.Next.Select
    s(i) = Range("MH1208").Value
Next i
Sheets("Sheet1").Select
For i = 0 To c - 1
    Range("bn" & i + 1) = s(i)
Next i
For i = 0 To c - 1
    q(i) = Range("bo" & i + 1).Value
Next i
Sheets("Sheet1").Select
ActiveSheet.Next.Select
ActiveSheet.Next.Select
For i = 0 To c - 1
    ActiveSheet.Next.Select
    Range("MG1208").Value = q(i)
Next i
End Sub

**Amir Ghasemiyan** · 2013/12/29, 20:23

نوشته اصلی توسط ali65e

امیر جان جسارتا یه مارکو می خوام که اطلاعات سلول های a1 شیت هایی که ماکرویه قبلی به تعداد دانش آموزان ایجاد کرده رو با هم جمع کنه و حاصل جمعشو تو سلول مثلا b1 بنویسه.متن مارکوهایی که فایلم با اون کار می کنه رو خدمتتون میذارم

بفرماييد خدمت شما

کد:

Sub sums() a = Range("A1").Value For i = 1 To Worksheets.Count - 1 ActiveSheet.Next.Select a = Range("A1").Value + a Next i Sheets("sheet1").Select Range("B1").Value = a End Sub