نویسنده موضوع: نیازمند یک ماکرو برای Insert Row در آخرین ردیف table  (دفعات بازدید: 70 بار)

omid8660

  • کاربر تازه‌وارد
  • *
  • ارسال: 12
  • جمع امتیازها: +0/-0
با سلام و عرض ادب خدمت اساتید خودم

یک ماکرو و یا کد نیاز دارم که بتونه در آخرین ردیف table به تعدادی که در یک سل مشخص کردم ردیف اضافه کنه

* البته در صورت تغییر عدد در سلول یاد شده به طور مثال با کم کردن این عدد تعداد ردیف حذف و یا با زیاد کردن زیاد شود.

سپاسگذار از کمک عزیزان

majid_mx4

  • مدیران انجمن
  • *
  • ارسال: 1992
  • جمع امتیازها: +798/-7
لطفا فایل ضمیمه را بررسی نمایید.

موفق باشید میر

omid8660

  • کاربر تازه‌وارد
  • *
  • ارسال: 12
  • جمع امتیازها: +0/-0
با عرض سلام و ارادت به استاد میر عزیز و بزرگوار
سپاسگزارم که وقت گذاشتید
استاد من می خوام در table این اتفاق بیافته ، الان ردیف رو کم می کنه ولی برای اضافه شدن ستون اضافه می شه
فایل رو براتون می فرستم ملاحظه بفرمایید

سپاسگزارم

majid_mx4

  • مدیران انجمن
  • *
  • ارسال: 1992
  • جمع امتیازها: +798/-7
با سلام

دوست عزیز اضافه شدن ستون بخاطر اتو تیبل می باشد لطفا خانه C4 را انتخاب و آن را به خانه D4 انتقال(Move) دهید.

سپس دستورات زیر را جایگزین دستورات قبل نمایید.
Sub addrowtotable2()
Dim Lastrow  As Long
Dim L As Integer
Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("Table1")
Dim newrow As ListRow
Set newrow = tbl.ListRows.Add

 Lastrow = Sheet1.Cells(Rows.Count, "b").End(3).Row + 1

 
L = Sheet1.Range("D4")

If L > 0 Then
   
    With newrow
      Cells(Lastrow, 2).Resize(L - 1).EntireRow.Insert
    End With
   End If


If L < 0 Then
    L = L * -1
    Range(Cells(Lastrow - L, 2), Cells(Lastrow, 2)).Delete Shift:=xlUp
End If


 End Sub


موفق باشید میر

omid8660

  • کاربر تازه‌وارد
  • *
  • ارسال: 12
  • جمع امتیازها: +0/-0
با سلام و عرض ادب خدمت استاد میر بزرگوار
عیدتون مبارک باشه
استاد من هنوز نتونستم مشکل این فایل رو حل کنم  :( :)
اگر راهنمایی بفرمایید ممنون می شم