ماکرو برای پاک کردن هوشمند

[Amir Ghasemiyan]

متشكرم كاركرد عالی بود راستی آقای مهندس چطوری میتونم باهاتون تماس بگیرم پروژه ای هست که احتمالا نیاز به همکاری تان داشته باشم ایمیل و تلفن بنده 09148126073 taocom52@gmail.com

خواهش میکنم دوست عزیز
اگر پروژه دارید میتونین از طریق صفحه سفارش پروژه درخواستتون رو برای تیم پروژمون بفرستید. مسئول پروژه یا بنده در تماس خواهیم بود با شما
موفق باشید

[taocom52]

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

[Amir Ghasemiyan]

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

دوست عزیز شما گفتین میخوام ردیف رو انتخاب کنم بعد که کلیک کردم بره جدولی که انتخاب شده رو پاک کنه. منم کد رو مطابق اون براتون نوشتم
ولی بایگانی که شما میگین یک عملیات کلی هست و در انتها هم دارین سلول a329 رو انتخاب میکنید. بعد نباید توقع داشته باشید اون کد بیاد جدولاتون رو خالی کنه

[taocom52]

نه مهندس من اونو اصلا پاک کردم (اون ماله وقتی که در ms box کلمه no را انتخاب میکنیم یعنی کاری انجام نده و a329 را انتخاب کنه ) بعبارتی انتخاب سلولی که اول انجام دادیم بقوت خودش باقی باشه مگر اینکه تصور بنده غلط باشه ، یعنی بعد از عملیات ماکرو selaction دیگه اون سلولی نباشه که اول انتخاب کردیم ، در این صورت به کمک شما باز نیاز دارم

[Amir Ghasemiyan]

نه مهندس من اونو اصلا پاک کردم (اون ماله وقتی که در ms box کلمه no را انتخاب میکنیم یعنی کاری انجام نده و a329 را انتخاب کنه ) بعبارتی انتخاب سلولی که اول انجام دادیم بقوت خودش باقی باشه مگر اینکه تصور بنده غلط باشه ، یعنی بعد از عملیات ماکرو selaction دیگه اون سلولی نباشه که اول انتخاب کردیم ، در این صورت به کمک شما باز نیاز دارم

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

[taocom52]

بنده در فایلی که در سوال اول براتون فرستادم ،یک ماکرو دارم که وقتی روی عدد قرمز select ميكني و آن ماكرو را اجرا ميكني ، سطر مورد نظر را از محل انتخاب تا 14 ستون (که در ماکرو این اعداد قابل کنترول هستند) را در شیت 2 کپی میکنه (بایگانی میشوند) سطری که بایگانی میشه سلولهاش حاصل از لینک از سلولهای همان جداول هستند و وقی بایگانی میشوند دیگر به داده های جدول متناظر نیازی نیست و باید داده های جدول پاک بشوند ، در حقیقت کدی که شما زحمتشو کشیدید بایستی بعد انجام بایگانی سطر، اجرا بشه تا داده های جدول هم پاک بشوند یعنی هردو کد با یک دکمه اجرا بشود که با الطبع اول باید بایگانی صورت گیرد بعد پاک شدن جدول .

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

[Amir Ghasemiyan]

درسته. حالا کامل متوجه شدم
کد macro1 که مربوط به بایگانی هست رو اینطوری اصلاح کنید:

Sub Macro1()
Application.ScreenUpdating = False
Dim C
Dim i
x = MsgBox("áØÝÇ ãØãÆä ÔæíÏ ˜å ÔãÇÑå Óåã ÑÇ ÏÑ ÓÊæä ÓÈÒ Ñä äÔÇä ÏÇÏå ÔÏå  ÇäÊÎÇÈ ˜ÑÏå ÇíÏ ÏÑ ÛíÑ ÇíäÕæÑÊ  Óåã ÔãÇ ÏÑÓÊ ÈÇíÇäí äÎæÇåÏ ÔÏ æ ÇÔ˜ÇáÇÊí ÏÑ ãÍÇÓÈÇÊ ÑíÇáí íÔ ÎæÇåÏ ÂãÏ", vbYesNoCancel, "massage box")
If x = vbYes Then
For Each C In Sheet2.Range("a1:a10000")
If C = Empty Then
For i = 0 To 14
C.Offset(0, i) = Selection.Offset(0, i)
Next i
ExcelIran
Exit Sub
End If
Next


                ElseIf x = vbNo Then
Range("a329").Select


End If


Application.ScreenUpdating = True
End Sub

کدهایی هم که قبلا خدمتتون دادم به این صورت اصلاح کنید:

Sub ExcelIran()
ActiveSheet.Unprotect "123"
Dim cel As Range
Dim TableNum As Integer
i = ActiveCell.Row
If i <= 21 And i >= 19 Then
    TableNum = Range("A" & i).Value
    For Each cel In Sheet1.Range("B" & i & ":N" & i)
        cleared = clearcontent(cel.Value, TableNum)
    Next cel
End If
ActiveSheet.Protect "123"
End Sub
Function clearcontent(cel, TableNum As Integer)
Dim C As Range
Select Case TableNum
    Case 1
        For Each C In Range("B1:H14")
            If C.Value = cel Then
                C.ClearContents
                Exit For
            End If
        Next C
    Case 2
        For Each C In Range("J1:P14")
            If C.Value = cel Then
                C.ClearContents
                Exit For
            End If
        Next C
    Case 3
        For Each C In Range("R1:X14")
            If C.Value = cel Then
                C.ClearContents
                Exit For
            End If
        Next C
End Select
End Function

[taocom52]

عالی بود مهندس ، تو ارتباط بین ماکروها واقعا مشکل داشتم که در این ماکرو اونو هم آموختم ممنون خسته نباشید

[Amir Ghasemiyan]

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