توضیح کد انتقال اطلاعات به شیت هم نام

[امیر رضا]

سلام دوستان عزیز شب همگی بخیر

ببینید من یک شیت دارم که تعداد زیادی رکورد در اون هست چون نتونستم اونو آپ کنم مجبورم توضیح بدم

ستون B = تاریخ ستون C = مبلغ تراکنش ستون D = تعداد تراکنش و ستون آخر E = کد خودرو

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

من میخواستم بر اساس کد هر خودرویی که توی ستون E هست اطلاعات فیلتر بشه و یک شیت جدید با همان کد خودرو ایجاد بشه و اطلاعات فیلتر شده اونجا قرار بگیره یا کپی بشه و نهایتا زیر ستونهای C - D هم جمع هر ستون آورده بشه

خب استاد شمس واقعا منو خجالت زده کردند و دو هزار خط کد منو به چند سطر تقلیل دادن یعنی یه چیز کاملا جدا از کد من (اینجاست که فرق جوجه اکسل با استاد مشخص میشه)

خب از اونجایی که دیگه نمی خوام مجددا زحمتی گردن ایشون بیفته خواستم از محتوای منظورم مطلع شده باشید و سورسی که ایشون برای من زدند رو کامنت گزاری کنید تا بفهمم دقیقا چه کاری انجام شده واقعا محبت میکنید از نتیجه همکاریتون منو مطلع کنید همینجا مجددا از همه شما دوستان گلم و از استاد شمس العلما واقعا قدردانی میکنم

Dim c As Range
For Each c In Sheet1.Range("A3:A13000")
    Dim ws, m
    For Each ws In Worksheets
    
    m = 0
        If ws.Name = c.Offset(0, 4).Value Then
        m = 1
        Exit For
        End If
    Next
    
    If (m <> 0) Then
   
    Else
        
        
        If c.Offset(0, 4) <> "" Then
            
                Sheets.Add After:=Sheets(Sheets.Count)
                Application.ActiveSheet.Name = c.Offset(0, 4).Value
                Dim n
                n = 0
                Dim cb As Range
                
                
               Sheets(c.Offset(0, 4).Value).Range("a2").Offset(0, 0).Value = "رديف"
                      Sheets(c.Offset(0, 4).Value).Range("a2").Offset(0, 1).Value = "تاريخ توليد-تاريخ"
                      Sheets(c.Offset(0, 4).Value).Range("a2").Offset(0, 2).Value = "مبلغ تراكنش"
                      Sheets(c.Offset(0, 4).Value).Range("a2").Offset(0, 3).Value = "تعداد تراكنش"
                      Sheets(c.Offset(0, 4).Value).Range("a2").Offset(0, 4).Value = "اتوبوس "
                For Each cb In Sheet1.Range("A3:A13000")
                 
                    If cb.Offset(0, 4).Value = c.Offset(0, 4).Value And cb.Offset(0, 4) <> "" Then
                    n = n + 1
                      Sheets(c.Offset(0, 4).Value).Range("a2").Offset(n, 0).Value = n
                      Sheets(c.Offset(0, 4).Value).Range("a2").Offset(n, 1).Value = cb.Offset(0, 1).Text
                      Sheets(c.Offset(0, 4).Value).Range("a2").Offset(n, 2).Value = cb.Offset(0, 2).Text
                      Sheets(c.Offset(0, 4).Value).Range("a2").Offset(n, 3).Value = cb.Offset(0, 3).Text
                      Sheets(c.Offset(0, 4).Value).Range("a2").Offset(n, 4).Value = cb.Offset(0, 4).Text
                    End If
                Next cb
                Sheets(c.Offset(0, 4).Value).Range("a2").Offset(n + 1, 3) = "=SUM(R[-" & n & "]C:R[-1]C)"
                Sheets(c.Offset(0, 4).Value).Range("a2").Offset(n + 1, 2) = "=SUM(R[-" & n & "]C:R[-1]C)"
         
        End If
    End If


Next c

مخصوصا این قسمت :

 m = 0
        If ws.Name = c.Offset(0, 4).Value Then
        m = 1
        Exit For


اگه خط به خط توضیح بدید تا سر در بیارم خیلی ممنون میشم شبتون شیک

[~M*E*H*D*I~]

در این کد ابتدا بررسی میشه شیتی هم نام با کد خودرو نباشه اگر بود m=1 و اگر نبود m=0 ،

در صورتی که m=0 بود به رنج حاوی کد خودرو ارجاع داده و بر اساس هر کد یک شیت تولید شده

Sheets.Add After:=Sheets(Sheets.Count)
                Application.ActiveSheet.Name = c.Offset(0, 4).Value

بعد از تولید شیت هیدر ها ( سر ستون ها) به هر شیت اضافه میشه

بقیش هم اطلاعات رو بر اساس کد به شیت اضافه میکنه البته من نمیدونم اطلاعات شما دقیقا چی بود که مجموعش رو حساب کرده