मैं वर्तमान में एक वर्कशीट बना रहा हूं जो एक्सेल में पंक्तियों को ले जाती है जिसमें एक सेल होता है जिसमें "वोल्टॉयड" टेक्स्ट होता है जो दूसरी वर्कशीट में होता है। मैं सेल वैल्यू के आधार पर या तो पंक्तियों को स्थानांतरित करना चाहता हूं, या कॉपी + पेस्ट करना और उन्हें हटाना चाहता हूं।

अब तक, मैं एक ऐसा फ़ंक्शन बनाने में सक्षम हूं जो तालिका में पंक्तियों को हटा देता है। कृपया नीचे दिए गए कोड को देखें:

Sub DeleteCompleted()
Dim Test1 As ListObject
Dim Test2 As Variant
Dim Rowcount As Integer

Set Test1 = Sheets("To Do Lijst").ListObjects("Table2")
Test2 = Test1.ListRows.Count

For Rowcount = 1 To Test2 Step 1
    If Test1.DataBodyRange(Rowcount, 4) = "Voltooid" Then
    Test1.DataBodyRange(Rowcount, 4).Delete Shift:=xlUp
    Rowcount = 0
    End If
Next Rowcount

क्या आप मेरे लिए एक बेहतर प्रारूप सुझा सकते हैं?

सधन्यवाद,

पीआईएम

1
Pim Caris 11 सितंबर 2018, 13:54

1 उत्तर

सबसे बढ़िया उत्तर
  1. वर्णनात्मक चर नामों का उपयोग करना आपके जीवन को आसान बनाता है
  2. पंक्ति गणना चर के लिए हमेशा Long का उपयोग करें, एक्सेल में Integer की तुलना में अधिक पंक्तियां हैं। साथ ही कभी भी Variant का उपयोग न करें जब तक कि आपको वास्तव में ऐसा न करना पड़े।
  3. यदि आप पंक्तियों को हटाते/जोड़ते हैं तो आपको पीछे की ओर लूप करना होगा, क्योंकि हटाने/जोड़ने से पंक्ति गणना बदल जाती है।
  4. एक पंक्ति को स्थानांतरित करने के लिए Range().Cut का उपयोग करें और एक गंतव्य को परिभाषित करें, उदाहरण के लिए किसी अन्य कार्यपत्रक में अगली निःशुल्क पंक्ति।

तो आप कुछ इस तरह खत्म करते हैं ...

Sub DeleteCompleted()
    Dim ToDoList As ListObject
    Dim ListRowCount As Long
    Dim iRow As Long

    Set ToDoList = Sheets("To Do Lijst").ListObjects("Table2")
    ListRowCount = ToDoList.ListRows.Count

    Dim NextFreeRow As Range

    For iRow = ListRowCount To 1 Step -1
        With ToDoList
            If .DataBodyRange(iRow, 4).Value = "Voltooid" Then
                Set NextFreeRow = Worksheets("Destination").Cells(Rows.Count, 4).End(xlUp).Offset(1, -3)
                ToDoList.ListRows(iRow).Range.Copy Destination:=NextFreeRow
                ToDoList.ListRows(iRow).Range.Delete Shift:=xlUp
            End If
        End With
    Next iRow
End Sub
1
Pᴇʜ 12 सितंबर 2018, 15:20