معنای کدهای vba و نحوه و ترتیب اجرا و خوانده شدن کد ها و for تو درر تو (با تشکر از M_Excel عزیز برای نوشتن کد عالی)

Collapse
X
Collapse
 
  • صفحه از 1
  • زمان
  • نمایش
حذف همه
new posts
قبلی template بعدی
  • sooroosh1315

    • 2019/06/03
    • 19
    #1

    پرسش معنای کدهای vba و نحوه و ترتیب اجرا و خوانده شدن کد ها و for تو درر تو (با تشکر از M_Excel عزیز برای نوشتن کد عالی)

    سلام و ممنون برای کد فوق العاده ای که نوشتین

    امکانش هست لطفا در مورد عبارات و متغییر هایی که نوشتین توضیح بدهید که هر خط چه کاری انجام می دهد؟
    کد PHP:
    Sub M_E()
    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lc1     = Sheets("new").Cells(Rows.Count, 1).End(3).Row
    For i = 1 To lc1
    Range    ("a100").End(3).Offset(1, 0) = Sheets("new").Cells(i + 1, 1)
    Next i

    lr     = Sheets("asli").Cells(Rows.Count, 1).End(3).Row
    Range    ("$A$1:$A$" & lr).RemoveDuplicates Columns:=1, Header:=xlYes
    lc2     = Sheets("asli").Cells(Rows.Count, 1).End(3).Row
    Range    ("f2:F" & lc2).ClearContents
    Range    ("B2:E" & lc2).Cut Destination:=Range("C2:F" & lc2)
    For     i = 2 To lc2
    For Z = 2 To lc1
    If Range("a" & i) = Sheets("new").Range("a" & Z) Then
    Range    ("b" & i) = Sheets("new").Range("b" & Z)
    End If
    Next Z
    If WorksheetFunction.Count(Range("b" & i & "" & i)) > 0 Then
    Range    ("g" & i) = WorksheetFunction.Sum(Range("b" & i & "" & i)) / WorksheetFunction.Count(Range("b" & i & "" & i))
    End If
    Next i
    .ScreenUpdating = True
    .EnableEvents = True
    End With
    End Sub 
    اگر در ستون b یک فرمول داشته باشیم و بخواهیم با دستور کات فقط مقدار عددیش به ستون بعدی منتقل بشه و فرمول در b ستون بماند چکار باید کرد؟

    مثلا ستون b برابر باشد با c+d بعد بخواهیم مقدار عددی ستون b به ستون c منتقل شود.

    ("b" & i & ": d
    " & i) این به چه معناست ؟
    Last edited by حسام بحرانی; 2019/06/07, 01:25. دلیل: قرار دادن کد در تگ
    برچسب ها: هیچ‌کدام
    • sooroosh1315

      • 2019/06/03
      • 19
      #2
      سلام کد را مقداری تغییر دادم تا با شرایطم یکی شود

      اما یکی از خط ها ارور می دهد
      کد PHP:
      Sub M_E()With Application    .ScreenUpdating = False    .EnableEvents = Falselc1 = Sheets("new").Cells(Rows.Count, 1).End(3).Row    For i = 1 To lc1        Range("a1000").End(3).Offset(1, 0) = Sheets("new").Cells(i + 1, 1)    Next i
          lr       = Sheets("asli").Cells(Rows.Count, 1).End(3).Row    Range("$A$1:$A$" & lr).RemoveDuplicates Columns:=1, Header:=xlYes    lc2 = Sheets("asli").Cells(Rows.Count, 1).End(3).Row    Range("BLK1:BNU" & lc2).ClearContents    Range("B1:BLK" & lc2).Cut Destination:=Range("BL1:BNU" & lc2)        For i = 1 To lc2                    For Z = 1 To lc1                        If Range("a" & i) = Sheets("new").Range("a" & Z) Then                             Range("B:BK" & i) = Sheets("new").Range("B:BK" & Z)                         End If                    Next Z                If WorksheetFunction.Count(Range("b" & i & ":d" & i)) > 0 Then                    Range("BNV" & i) = WorksheetFunction.Sum(Range("b" & i & ":d" & i)) / WorksheetFunction.Count(Range("b" & i & ":d" & i))                End If        Next i        .ScreenUpdating = True.EnableEvents = TrueEnd WithEnd Sub 
      باید تمام حروف از B تا BK را دستی بنویسم؟ یا می شود بشکل صحیح رنج داد؟

      ارور:
      کد PHP:
      Range("B:BK" & i) = Sheets("new").Range("B:BK" & Z) 
      در فایل شما:
      کد PHP:
      Range("b" & i) = Sheets("new").Range("b" & Z) 

      بعد اگر بخواهم در ستون C یک فرمول بنویسم : مثلا

      کد PHP:
      =D+E 
      چطور باید وارد کنم؟

        کامنت

        • sooroosh1315

          • 2019/06/03
          • 19
          #3
          فکر می کنم باید اینجور می نوشتم:
          کد PHP:
           Range("B:BK").Rows(i) = Sheets("new").Range("B:BK").Rows(i) 
          الان ارور نمی دهد ولی دیگه همون ستون دوم را هم منتقل نمی کند

          می خواهم 62 ستون از فایل NEW به ستون دوم تا 63 ام اضافه شود


          راستی یک مشکل عجیب کلید همراه با کپی پیست ها حرکت می کند و 63 خانه به سمت راست می رود :| چطور می شود ثابتش کرد.

            کامنت

            • sooroosh1315

              • 2019/06/03
              • 19
              #4
              به این شکل تغییرش دادم
              کد PHP:
               Worksheets("asli").Range("B:BK").Rows(i).Value = Worksheets("new").Range("B:BK").Rows(i).Value 
              ایرادی به کار وارد نمی کند؟

                کامنت

                • sooroosh1315

                  • 2019/06/03
                  • 19
                  #5
                  این دستور را چطور میشه وارد کرد:

                  اگرسطر دوم ستون V فایل new کوچکتر یا مساوی با سطر دوم ستون V فایل asli بود ماکرو اجرا نشه (تغییری در فایل ایجاد نشود.)

                    کامنت

                    • sooroosh1315

                      • 2019/06/03
                      • 19
                      #6
                      یک سوال سخت:
                      کد PHP:
                      If WorksheetFunction.Count(Range("b" & i & ":d" & i)) > 0 Then 
                      این میاد ستون b , c , d را در سر i در نظر میگیرد اگر درست بگم

                      حالا یک مشکل من اطلاعات ستون b , سطر i را می خواهم و اطلاعات 62 تا ستون بعدش و باز 62 تا ستون بعدش ...تا بشه 28 تا ستون (بشماره چنتاشون از صفر بزرگتره ) (در کل 1732 تا ستون دارم که 62 تا 62 تا تکرار میشن) بعد مجموع همشون رو حساب کنه و تقسیم بر تعدادشون بکنه

                      فکر می کنم باید از offset استفاده کرد اما چطور ؟ (میشه ی حلقه ی فور جدید براش ساخت؟

                        کامنت

                        • M_ExceL

                          • 2018/04/23
                          • 677
                          #7
                          نوشته اصلی توسط sooroosh1315
                          سلام و ممنون برای کد فوق العاده ای که نوشتین

                          امکانش هست لطفا در مورد عبارات و متغییر هایی که نوشتین توضیح بدهید که هر خط چه کاری انجام می دهد؟
                          کد PHP:
                          Sub M_E()
                          With Application
                          .ScreenUpdating = False
                          .EnableEvents = False
                          lc1                           = Sheets("new").Cells(Rows.Count, 1).End(3).Row
                          For i = 1 To lc1
                          Range                          ("a100").End(3).Offset(1, 0) = Sheets("new").Cells(i + 1, 1)
                          Next i

                          lr                           = Sheets("asli").Cells(Rows.Count, 1).End(3).Row
                          Range                          ("$A$1:$A$" & lr).RemoveDuplicates Columns:=1, Header:=xlYes
                          lc2                           = Sheets("asli").Cells(Rows.Count, 1).End(3).Row
                          Range                          ("f2:F" & lc2).ClearContents
                          Range                          ("B2:E" & lc2).Cut Destination:=Range("C2:F" & lc2)
                          For                           i = 2 To lc2
                          For Z = 2 To lc1
                          If Range("a" & i) = Sheets("new").Range("a" & Z) Then
                          Range                          ("b" & i) = Sheets("new").Range("b" & Z)
                          End If
                          Next Z
                          If WorksheetFunction.Count(Range("b" & i & "" & i)) > 0 Then
                          Range                          ("g" & i) = WorksheetFunction.Sum(Range("b" & i & "" & i)) / WorksheetFunction.Count(Range("b" & i & "" & i))
                          End If
                          Next i
                          .ScreenUpdating = True
                          .EnableEvents = True
                          End With
                          End Sub 
                          اگر در ستون b یک فرمول داشته باشیم و بخواهیم با دستور کات فقط مقدار عددیش به ستون بعدی منتقل بشه و فرمول در b ستون بماند چکار باید کرد؟

                          مثلا ستون b برابر باشد با c+d بعد بخواهیم مقدار عددی ستون b به ستون c منتقل شود.

                          ("b" & i & ": d
                          " & i) این به چه معناست ؟
                          سلام،
                          خواهش میکنم،
                          برای درک کدها لازم است با مباحث vba آشنا باشید لذا در همین انجمن و نیز در سطح نت مثال ها و آموزش هایی موجود هست که می تونید استفاده کنید.
                          در خصوص سوالاتی که مطرح فرمودید بهتر است یکبار خواستتون رو بطور دقیق به همراه فایل قرار بدید، بنده یا دوستان عزیزمون سر فرصت اگر در توانمون باشه کمک خواهیم کرد.
                          یا حق.
                          [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
                          [/CENTER]

                            کامنت

                            • sooroosh1315

                              • 2019/06/03
                              • 19
                              #8
                              نوشته اصلی توسط M_ExceL
                              سلام،
                              خواهش میکنم،
                              برای درک کدها لازم است با مباحث vba آشنا باشید لذا در همین انجمن و نیز در سطح نت مثال ها و آموزش هایی موجود هست که می تونید استفاده کنید.
                              در خصوص سوالاتی که مطرح فرمودید بهتر است یکبار خواستتون رو بطور دقیق به همراه فایل قرار بدید، بنده یا دوستان عزیزمون سر فرصت اگر در توانمون باشه کمک خواهیم کرد.
                              یا حق.

                              سلام و عرض ادب

                              این کد در خط 5 ام ارور می دهد بعد از وارد شدن خط مربوط به max , min علت چیست؟ چطور بر طرف میشه؟
                              (احتمال می دم از type هست)


                              کد PHP:
                              Sub m_e()With Application    .ScreenUpdating = False    .EnableEvents = Falselc1 = Sheets("new").Cells(Rows.Count, 1).End(3).Row    For i = 1 To lc1        Range("a1000").End(3).Offset(1, 0) = Sheets("new").Cells(i + 1, 1)    Next i
                                  lr                               = Sheets("asli").Cells(Rows.Count, 1).End(3).Row    Range("$A$1:$A$" & lr).RemoveDuplicates Columns:=1, Header:=xlYes    lc2 = Sheets("asli").Cells(Rows.Count, 1).End(3).Row    Range("BLK1:BNU" & lc2).ClearContents    Range("B1:BLK" & lc2).Cut Destination:=Range("BL1:BNU" & lc2)        For i = 1 To lc2                    For Z = 1 To lc1                        If Range("a" & i) = Sheets("new").Range("a" & Z) Then                             Worksheets("asli").Range("B:BK").Rows(i).Value = Worksheets("new").Range("B:BK").Rows(Z).Value                             Z = lc1                         End If                    Next Z                If i > 1 Then                Range("ad" & i).Value = Application.WorksheetFunction.Average(Cells(i, 10), Cells(i, 72), Cells(i, 134), Cells(i, 196), Cells(i, 258), Cells(i, 320), Cells(i, 382))                Range("x" & i).Value = Application.WorksheetFunction.Min(Cells(i, 3), Cells(i, 65), Cells(i, 127), Cells(i, 189), Cells(i, 251), Cells(i, 313), Cells(i, 375), Cells(i, 437), Cells(i, 499), Cells(i, 561), Cells(i, 623), Cells(i, 685), Cells(i, 747), Cells(i, 809), Cells(i, 871), Cells(i, 933), Cells(i, 995), Cells(i, 1057), Cells(i, 1119), Cells(i, 1181), Cells(i, 1243), Cells(i, 1305), Cells(i, 1367), Cells(i, 1429), Cells(i, 1491), Cells(i, 1553), Cells(i, 1615), Cells(i, 1677))                Range("y" & i).Value = Application.WorksheetFunction.Max(Cells(i, 3), Cells(i, 65), Cells(i, 127), Cells(i, 189), Cells(i, 251), Cells(i, 313), Cells(i, 375), Cells(i, 437), Cells(i, 499), Cells(i, 561), Cells(i, 623), Cells(i, 685), Cells(i, 747), Cells(i, 809), Cells(i, 871), Cells(i, 933), Cells(i, 995), Cells(i, 1057), Cells(i, 1119), Cells(i, 1181), Cells(i, 1243), Cells(i, 1305), Cells(i, 1367), Cells(i, 1429), Cells(i, 1491), Cells(i, 1553), Cells(i, 1615), Cells(i, 1677))                End If        Next i                                     .ScreenUpdating = True.EnableEvents = TrueEnd WithEnd Sub 


                              Click image for larger version Name: EXCEL_gUufsafq1H.png Views: 1 Size: 50.8 کیلو بایت ID: 135454
                              بعد از اضافه شدن دو خط سبز رنگ ، خط زرد رنگ ارور می دهد.
                              Last edited by sooroosh1315; 2019/06/08, 19:06.

                                کامنت

                                قبلی template بعدی
                                چند لحظه..