حذف يك سطر با ماكرو

[4017]

با سلام
چطوري ميشه با ماكرو نويسي هر سطري رو كه مثلا عدد ۱ (يا هر عدد دلخواه ديگه) در ستون اولش داره رو حذف كرد؟

[khakzad]

سلام
فایل رو ملاحظه کنید لطفا

[4017]

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

[khakzad]

سلام و ممنون
اول ماکرو رو enable کنید از مسیر excel option-trust center-trust center setting-enable macroes. . . . . .

[4017]

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

[khakzad]

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

[4017]

با احترام
راستش من فايلي كه زحمتشو كشيدين رو با زدن alt+F11 رفتم تو ماكروش
اما ماكرويي پيدا نكردم. اگه امكان داره يه بازديد بفرماييد
از كمكتون ممنونم

[khakzad]

شرمنده
نمیدونم چرا سایت فایل macro enable نمیگیره
ایمیل بدین بفرستم
معذرت می خوام

[4017]

با احترام
سپاگذارم از شما خواهر گرامي
mehrdad.mohammadpoor@gmail.com

[khakzad]

فزستادم
اپلود هم کردم
http://www.4shared.com/file/B_D1nau7/hazf_radif.html

[4017]

با احترام و آرزوي بهترينها براي شما دوست عزيز[hr]
با احترام
فقط يه مشكل هست اونم اينه كه چطوري ميشه يه سطر كامل حذف بشه؟
مثلا اگه a10 برابر با يه عدد شد اون سطر rows("10:10") حذف بشه
بهتره اينطور بگم كه من يه ليست فاكتور دارم كه هر دفعه كه ميخوام فاكتور جديدي بزنم ميخوام سطرهاي فاكتور قبلي حذف بشه در حالي كه بعضي از سطرها مثل جمع كل يا ۳٪ ارزش افزوده نميخوام حذف بشه
در مورد اين مشكل يه راه حل بهم ميگيد؟
ممنون از لطفتون

[4017]

در رابطه با درخواستي كه داشتم يه ماكرو نوشتم اما اشكال داره اونم اينه كه وقتي ميخواد حذف كنه نصف نصف اين كارو ميكنه يعني اگه ۲۰ سطر باشه اولش ميشه ۱۰ تا. دوباره ميزنم ميشه ۵ تا و ...
البته اين ماكرو در مورد هر عدد بزرگتر از ۰ اجرا ميشه
Sub dd()
On Error Resume Next
Dim c As Range
For Each c In Range("a1:a100")
If c > 0 Then
c.EntireRow.Delete
End If
Next
End Sub
ميشه راهنماييم كنيد؟

[khakzad]

در فایل قبل که همین اجرا میشه!!!
کل ردیف حذف میشه!
واضح تر بفذمایید

[4017]

با سلام
فايلي كه شما زحمتشو كشيدين درست بود. من منظورمو كامل نتونستم برسونم. من يه فاكتور دارم كه هر دفعه كه ميخوام يه فاكتور جديد بزنم ميخوام سطرهاي قبلي پاك بشه. ميخوام طوري باشه كه فقط داده هاش پاك بشه و جمع كل يا چيزاي ديگه بمونه. يه ماكرو هم نوشتم اما نصفه كار ميكنه
http://rapidshare.com/files/453960656/Book1.xlsm
اينم لينك فايلمه. ممنون از راهنماييتون
http://free-user.s99.rapidbaz.com:8080/free/yDErwFG7KnZmWOB5CK6ogPsRFpV28TbX4NGo7VOJw_aFyym9Nm cR-rV7fElSHBKQwde-uJC1z03-dDJQZYJH0FFsek87n3GJif5CPxXg/Book1.xlsm اينم يه لينك ديگه[hr]
ماكرو با دبل كليك روي ستون كد محصول اجرا ميشه

[4017]

با تشكر از دوست خوبم khakzad
به جواب رسيدم. راستش من راه سختو انتخاب و بيان كرده بودم در حالي كه يه راه خيلي ساده هم داشت
Sub del_list()
Application.ScreenUpdating = False
Sheet2.Select
Range("A9").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
Range("A6").Select
Sheet1.Select
Range("a2").Select
End Sub
اين كارمو راه انداخت. بازم از توجهتون ممنونم

[emran]

با این کد میشه.

Sub Macro1()

For i = -100 To -1
If Cells(-i, 1).Value = "1" Then
Cells(-i, 1).EntireRow.Delete
End If
Next i
End Sub

[mohebbi_md]

سلام کد زیر رو تو یه ماکرو بنویس و امتحان کن امیدوارم به هدف برسی
Dim MyObject As Object
'To get Number of Source Row
intRowSource = InputBox("Enter Number of Row :", "Number of Row")
'Select Source Sheet
Sheets("Sheet1").Select
'Find The Last Row in Destination Sheet ( Sheet2 )
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row
For i = 2 To FinalRow
'Decide if to copy based on column A
ThisValue = Cells(i, 1).Value
'To check Number of Row
If ThisValue = intRowSource Then
Cells(i, 1).Resize(1, 33).Delete

End If
Next i

[shahin]

[Sub Example1()

Const strTOFIND As String = "Hello"

Dim rngFound As Range, rngToDelete As Range
Dim strFirstAddress As String

Application.ScreenUpdating = False

With Sheet1.Range("A:A")
Set rngFound = .Find( _
What:=strTOFIND, _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)

If Not rngFound Is Nothing Then
Set rngToDelete = rngFound

'note the address of the first found cell so we know where we started.
strFirstAddress = rngFound.Address

Set rngFound = .FindNext(After:=rngFound)

Do Until rngFound.Address = strFirstAddress
Set rngToDelete = Application.Union(rngToDelete, rngFound)
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With

If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete

Application.ScreenUpdating = True

End Sub

[mohsenp]

سلام
من یک ستون دارم که مثلا اعداد 1 تا 10 توی اون ستون نوشته شده . میخوام با ماکرو ، مثلا ردیف 4 از این ستون رو حذف کنم بعد از حذف بین ردیف 3 و 5 فاصله میوفته. حالا میخوام از عدد 5 تا 10 تبدیل به 4 تا 9 بشه یعنی اعداد ستون به ترتیب از 1 تا 9 بشه

[alisabet]

سلام
من یک ستون دارم که مثلا اعداد 1 تا 10 توی اون ستون نوشته شده . میخوام با ماکرو ، مثلا ردیف 4 از این ستون رو حذف کنم بعد از حذف بین ردیف 3 و 5 فاصله میوفته. حالا میخوام از عدد 5 تا 10 تبدیل به 4 تا 9 بشه یعنی اعداد ستون به ترتیب از 1 تا 9 بشه

`پاسخ شما در موضوع ردیف اتوماتیک اینجا شماره ردیف اتوماتیک (http://forum.exceliran.com/showthread.php/1433)

[abootorab]

سلام
من یک ستون دارم که مثلا اعداد 1 تا 10 توی اون ستون نوشته شده . میخوام با ماکرو ، مثلا ردیف 4 از این ستون رو حذف کنم بعد از حذف بین ردیف 3 و 5 فاصله میوفته. حالا میخوام از عدد 5 تا 10 تبدیل به 4 تا 9 بشه یعنی اعداد ستون به ترتیب از 1 تا 9 بشه

با درود

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



Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
startrow = Target.Row
If Target.Offset(1, 0).Value = "" Then
endrow = startrow
Else
endrow = Target.End(xlDown).Row
End If
Rows(Target.Row).Delete
For i = startrow To endrow - 1
Cells(i, ActiveCell.Column).Value = Cells(i, ActiveCell.Column).Value - 1
Next i
Cancel = True
End Sub