پاک کردن ردیف با شرط

Collapse
X
 
  • زمان
  • نمایش
حذف همه
new posts
  • ali.b

    • 2014/01/12
    • 798

    پاک کردن ردیف با شرط

    با سلام
    من ی سری ردیف دارم که میخوام فقط اون ردیف هایی که در ستون d متن نمی باشد اومد اون ردیف رو پاک کنه
    فایل های پیوست شده

  • mokaram
    مدير تالار اکسل و بانک اطلاعاتی

    • 2011/02/06
    • 1805
    • 74.00

    #2
    نحوه کار را میشه بیشتر باز بکنید
    شما نوشته هاتون آماده هست بعد می خواهید این شرط اعمال بشه یا نه همون موقع که زدید مجاز نیست بعد اینتر زدید عمل حذف شدن انجام بشه یا شایدم طور دیگه ؟

    کامنت

    • Javid Mokhtari
      مدير تالار ويژوال بيسيك

      • 2012/01/16
      • 1212
      • 73.00

      #3
      نوشته اصلی توسط absorkhi
      با سلام
      من ی سری ردیف دارم که میخوام فقط اون ردیف هایی که در ستون d متن نمی باشد اومد اون ردیف رو پاک کنه
      با سلام.
      خ
      کد PHP:
      Public rw As String
      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      On Error Resume Next
      rw 
      Target.Address
      If Sheet1.Range(rw).Column And Sheet1.Range(rw).Row And Sheet1.Range(rw).Value "äãì ÈÇÔÏ" Then
      Rows
      (Sheet1.Range(rw).Row).Delete Shift:=xlUp
      End 
      If
      End Sub 
      دوره های آموزش رایگان اکسل از صفر تا پیشرفته بصورت تصویری
      بیش از 60 جلسه آموزش ویدئویی رایگان

      شرکت در دوره:

      https://javidsoft.ir/courses/


      کامنت

      • mokaram
        مدير تالار اکسل و بانک اطلاعاتی

        • 2011/02/06
        • 1805
        • 74.00

        #4
        با تشکر از آقا جاوید
        اگه کد بالا را به شکل زیر بنویسیم همون موقع جواب میده ( البته کد که همونه فقط ایونتش فرق کرده )
        البنه بهتره که کلمه نمی باشد را به یه خونه ربطش بدیم اینطوری نتیجه بهتری می گیریم
        کد PHP:
        Public rw As String

        Private Sub Worksheet_Change(ByVal Target As Range)
        On Error Resume Next
        rw 
        Target.Address
        If Sheet1.Range(rw).Column And Sheet1.Range(rw).Row And Sheet1.Range(rw).Value =sheet1.range("h1").value Then
        Rows
        (Sheet1.Range(rw).Row).Delete Shift:=xlUp
        End 
        If
        End Sub 

        کامنت

        • ali.b

          • 2014/01/12
          • 798

          #5
          با سلام
          میخوام بعد اینکه می باشد ها به شیت بعدی رفتن خودکار نمی باشد ها هم حذف بشن
          فایل های پیوست شده

          کامنت

          • Amir Ghasemiyan

            • 2013/09/20
            • 4537
            • 100.00

            #6
            خب دوستان با توضيحاتي كه دوستمون برام دادن متوجه شدم كدهايي كه شما اساتيد قرار دادين كارشون رو راه نميندازه
            ايشون ميخوان سطرهايي كه عبارت «مي باشد» داره رو به شيت ديگه اي منتقل كنن و از شيت مبدا حذف كنن، ولي نه بطور اتومات بلكه با زدن يك دكمه

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

            کد:
            Sub amir()
            Dim cel As Range
            Application.ScreenUpdating = False
            For Each cel In Range("D:D")
                If cel.Value = "" Then
                    w = cel.Row
                    Exit For
                End If
                If cel.Row > 2 And cel.Value = Range("D2").Value Then
                    Sheet1.Select
                    Rows(cel.Row).Copy
                    Sheet2.Select
                    If Range("A3").Value = "" Then
                        Rows("3:3").Insert Shift:=xlDown
                    ElseIf Range("A4").Value = "" Then
                        Rows("4:4").Insert Shift:=xlDown
                    Else
                        Range("A3").End(xlDown).Select
                        ActiveCell.Offset(1, 0).Range("A1").Select
                        Rows(Selection.Row).Insert Shift:=xlDown
                    End If
                End If
            Next cel
            Sheet1.Select
            While 1
            flag = 1
            For i = 3 To w
                If Range("D" & i).Value = Range("D2").Value Then
                    Rows(Range("D" & i).Row).Delete Shift:=xlUp
                    flag = 0
                End If
            Next i
            If flag = 1 Then Exit Sub
            Wend
            Application.ScreenUpdating = True
            End Sub
            فايل نمونه هم پيوست كردم مشاهده بفرماييد
            فایل های پیوست شده

            کامنت

            چند لحظه..