کد نویسی برای پاک کردن سلولهایک محدوده به غیر از سلولهای قفل شده.

Collapse
X
 
  • زمان
  • نمایش
حذف همه
new posts
  • taocom52

    • 2015/08/14
    • 99

    کد نویسی برای پاک کردن سلولهایک محدوده به غیر از سلولهای قفل شده.

    سلام ، من میخواستم محدوده نسبتا بزرگی از سلولهارا که دارای داده هایی هستند رو پاک کنم البته تعدادی از سلولهای این محدوده قفل هستند که باطبع نباید پاک شوند برای اینکار چگونهکد نویسی کنم؟ متشکرم.
  • M_ExceL

    • 2018/04/23
    • 677

    #2
    نوشته اصلی توسط taocom52
    سلام ، من میخواستم محدوده نسبتا بزرگی از سلولهارا که دارای داده هایی هستند رو پاک کنم البته تعدادی از سلولهای این محدوده قفل هستند که باطبع نباید پاک شوند برای اینکار چگونهکد نویسی کنم؟ متشکرم.
    سلام،
    نمونه فایل قرار بدید تا متناسب با اون کد نویسی صورت پذیرد.
    [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
    [/CENTER]

    کامنت

    • taocom52

      • 2015/08/14
      • 99

      #3
      فایل پیوست

      نوشته اصلی توسط M_ExceL
      سلام،
      نمونه فایل قرار بدید تا متناسب با اون کد نویسی صورت پذیرد.

      فایل رو براتون ارسال کردم سلولهایی که قفل هستند حاوی فرمولند و نیاید پاک بشند ولی سلولهای غیر قفل که فرمول ندارند کامل پاک شوند . البته ای قسمت کوچیکی از فایل اصلیه . متشکرم
      فایل های پیوست شده

      کامنت

      • M_ExceL

        • 2018/04/23
        • 677

        #4
        نوشته اصلی توسط taocom52
        فایل رو براتون ارسال کردم سلولهایی که قفل هستند حاوی فرمولند و نیاید پاک بشند ولی سلولهای غیر قفل که فرمول ندارند کامل پاک شوند . البته ای قسمت کوچیکی از فایل اصلیه . متشکرم
        سلام،
        بفرمایید :
        کد:
        Sub ClearUnlockedCells()
        Dim Rng As Range
        Dim WorkRng As Range
        On Error Resume Next
        Set WorkRng = Range("$A$3:$P$19")
        Application.ScreenUpdating = False
        For Each Rng In WorkRng
            If Rng.Locked = False Then Rng.ClearContents
        Next
        Application.ScreenUpdating = True
        End Sub
        رنج رو می تونید تغییر بدید داخل کد.
        یا حق.
        [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
        [/CENTER]

        کامنت

        • taocom52

          • 2015/08/14
          • 99

          #5
          متشکرم

          نوشته اصلی توسط M_ExceL
          سلام،
          بفرمایید :
          کد:
          Sub ClearUnlockedCells()
          Dim Rng As Range
          Dim WorkRng As Range
          On Error Resume Next
          Set WorkRng = Range("$A$3:$P$19")
          Application.ScreenUpdating = False
          For Each Rng In WorkRng
              If Rng.Locked = False Then Rng.ClearContents
          Next
          Application.ScreenUpdating = True
          End Sub
          رنج رو می تونید تغییر بدید داخل کد.
          یا حق.




          یک اشکال کوچیک داره که میخوام حلش کنم ،نتونستم باز زحمت میدم به شما. متشکرم

          کامنت

          • taocom52

            • 2015/08/14
            • 99

            #6
            سلام ، مهندس جان من رنج کدی که فرستاده بودید رو تغییر دادم ولی بعضی سلولهای غیر قفل شده رو پاک نمیکنه ، احتمالا سلولهایی که مرج هستند رو نمیشناسه مثل سلولی که تواون نوشتم خساپا ، فایل نمونه دوم رو میفرستم که کد شما رو با تغییر رنج رو به دکمه فایل اختصاص دادم ، لطف کنید یک بررسی بفرمایید. متشکرم
            فایل های پیوست شده
            Last edited by taocom52; 2019/04/12, 14:26.

            کامنت

            • taocom52

              • 2015/08/14
              • 99

              #7
              ببخشید فایل 2 رو اشتباه فرستادم لطفا فایل 3 رو بررسی بفرمایید متشکرم
              فایل های پیوست شده

              کامنت

              • M_ExceL

                • 2018/04/23
                • 677

                #8
                نوشته اصلی توسط taocom52
                ببخشید فایل 2 رو اشتباه فرستادم لطفا فایل 3 رو بررسی بفرمایید متشکرم
                سلام،
                کد اصلاح گردید :
                کد:
                Sub ClearUnlockedCells()
                Dim Rng As Range
                Dim WorkRng As Range
                On Error Resume Next
                Set WorkRng = Range("a1:ag41")
                Application.ScreenUpdating = False
                For Each Rng In WorkRng
                Rng.Select
                With Selection
                    If .Locked = False Then
                    .ClearContents
                    End If
                    End With
                Next Rng
                Application.ScreenUpdating = True
                End Sub
                [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
                [/CENTER]

                کامنت

                • taocom52

                  • 2015/08/14
                  • 99

                  #9
                  متشکرم حل شد . فقط نمیدونم شاید طبیعی باشه ولی سرعت پاک کردن کمی زیاد ، حدود 1 دقیقه طول میکشه ، محدوده پاک کردن a3:aw513 هست.اگر راهی هست برای افزایش سرعت که دعا گوییم اگرنه ف متشکرم از زحماتتون.

                  کامنت

                  • M_ExceL

                    • 2018/04/23
                    • 677

                    #10
                    نوشته اصلی توسط taocom52
                    متشکرم حل شد . فقط نمیدونم شاید طبیعی باشه ولی سرعت پاک کردن کمی زیاد ، حدود 1 دقیقه طول میکشه ، محدوده پاک کردن a3:aw513 هست.اگر راهی هست برای افزایش سرعت که دعا گوییم اگرنه ف متشکرم از زحماتتون.
                    سلام، خواهش میکنم
                    این مشکل رو بنده با سیستم خودم ندارم، دلیلش می تونه درگیری سیستم با برنامه ها و فایل های مختلف در حال اجرا یا سخت افزار ضعیف باشه، باز بررسی می کنم اگر شد کد دیگری تقدیم میکنم.
                    [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
                    [/CENTER]

                    کامنت

                    • taocom52

                      • 2015/08/14
                      • 99

                      #11
                      والا سیستم من بسیار قوی هست چون مخصوص رندر ینگ و انیمیشن هست ، ممکنه از ورژن آفیس یا فعال نبودنش باشه؟

                      کامنت

                      • M_ExceL

                        • 2018/04/23
                        • 677

                        #12
                        نوشته اصلی توسط taocom52
                        والا سیستم من بسیار قوی هست چون مخصوص رندر ینگ و انیمیشن هست ، ممکنه از ورژن آفیس یا فعال نبودنش باشه؟
                        سلام
                        می تونید از این کد استفاده کنید :
                        کد:
                        Sub ClearDataNotFormulas()
                        On Error Resume Next
                        Dim pws As String
                        pws = "123"
                        ActiveSheet.Unprotect Password:=pws
                          Cells.SpecialCells(xlCellTypeConstants).ClearContents
                        ActiveSheet.Protect Password:=pws
                        End Sub
                        داخل کد به جای 123 پسوردی رو که خودتون برای شیت مورد نظر تعریف کردید قرار بدید.
                        این کد در اصل مقادیر سلول هایی که داخل آن ها فرمولی به کار نرفته رو پاک میکنه.
                        بنابراین شما متونی رو که می خواهید پاک نشه رو هم بصورت فرمول وارد کنید تا اون سلول رو نادیده بگیره.
                        بطور مثال متن "وضعیت تحلیل" رو داخل سلول به صورت زیر وارد کنید تا حالت فرمول رو پیدا کنه.
                        کد:
                        ="وضعیت تحلیل"
                        اگر باز هم مشکل سرعت داشتید بگردید دنبال ایراد کار.
                        [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
                        [/CENTER]

                        کامنت

                        چند لحظه..