मेरे पास एक मैक्रो लिखा है जो सक्रिय सेल पंक्ति की सामग्री को साफ़ करता है और फिर शेष पंक्तियों को स्थानांतरित करने के लिए एक मॉड्यूल को कॉल करता है। मैक्रो के चलने के समाप्त होने के लिए मैं एक लंबे प्रतीक्षा समय का अनुभव कर रहा हूं। सुनिश्चित नहीं है कि यह तेजी से निष्पादित करने के लिए बेहतर लिखा जा सकता है। पहला मॉड्यूल तब कहा जाता है जब कोई उपयोगकर्ता उपयोगकर्ता प्रपत्र पर "ग्राहक निकालें" पर क्लिक करता है। किसी भी सहायता की सराहना की जाएगी। शुक्रिया!

'Called when user clicks Remove Client on User Form
Sub letsgo()

Dim ws As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set ws = wb.Sheets("contactunder")

ws.Range("C" & ActiveCell.Row & ":BJ" & ActiveCell.Row).ClearContents

Call shiftmeup
End Sub
Sub shiftmeup()

Dim ws As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set ws = wb.Sheets("contactunder") '/// The underhood of my contacts

With ws.Range("D11:BJ392")
For i = .Rows.Count To 1 Step -1
If IsEmpty(.Cells(i, 1)) Then .Rows(i).Delete Shift:=xlUp
Next
End With
End Sub
0
Jose Cortez 12 जून 2018, 21:47

2 जवाब

सबसे बढ़िया उत्तर

इस लाइन को क्यों न बदलें:

ws.Range("C" & ActiveCell.Row & ":BJ" & ActiveCell.Row).ClearContents

इसके लिए:

ws.Range("C" & ActiveCell.Row & "BJ" & ActiveCell.Row).EntireRow.Delete

इस तरह आप अपने दूसरे उप से एक साथ बच सकते हैं (या इसे कभी-कभार क्लीनर के रूप में रखें बल्कि इसे हर बार चलाएं जब आपको केवल 1 पंक्ति को हटाने की आवश्यकता हो।)

यदि आपको वास्तव में दोनों सब्सक्रिप्शन की आवश्यकता है, तो दक्षता के लिए एक सामान्य पहला कदम है Application.ScreenUpdating = False के साथ अपने लूप में प्रवेश करने से पहले स्क्रीन अपडेटिंग को अक्षम करना और फिर जब आपका लूप False को बदलकर True.

2
urdearboy 12 जून 2018, 22:25

यह urdearboy के उत्तर का अनुसरण है ...

समस्या आपके दूसरे फ़ंक्शन और उपयोग की जाने वाली स्थिर श्रेणी में थी। आप अंत में सभी पंक्तियों को हटा रहे थे, अपने डेटा के बाद (~ 380 अतिरिक्त पंक्ति कॉल हटाएं)। इसे ठीक करने के लिए आपको दो काम करने चाहिए

  1. डेटा की अंतिम पंक्ति के लिए केवल लूप
  2. कॉल को फ्रंट एंड तक सीमित करें; उन सभी कक्षों को एक श्रेणी में रखें जिन्हें आप हटाना चाहते हैं और इसे एक बार हटा दें

Sub ShiftMeUp()
Dim wb As Workbook
Dim ws As Worksheet
Dim DeleteRowRange As Range
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("contactunder") '/// The underhood of my contacts

    For i = 1 To GetLastRow(1, ws)
        If IsEmpty(ws.Cells(i, 1)) Then Set DeleteRowRange = MakeUnion(ws.Rows(i), DeleteRowRange)
    Next
    If Not DeleteRowRange Is Nothing Then DeleteRowRange.EntireRow.Delete Shift:=xlUp
End Sub

मैंने कोड को साफ रखने के लिए अपने आमतौर पर उपयोग किए जाने वाले कार्यों में 2 का उपयोग किया है ...

मेकयूनियन

Public Function MakeUnion(Arg1 As Range, Arg2 As Range) As Range
    If Arg1 Is Nothing Then
        Set MakeUnion = Arg2
    ElseIf Arg2 Is Nothing Then
        Set MakeUnion = Arg1
    Else
        Set MakeUnion = Union(Arg1, Arg2)
    End If
End Function

GetLastRow

Public Function GetLastRow(Optional Col As Integer = 1, Optional Sheet As Excel.Worksheet) As Long
    If Sheet Is Nothing Then Set Sheet = Application.ActiveSheet
    GetLastRow = Sheet.Cells(Sheet.Rows.Count, Col).End(xlUp).Row
End Function
0
Profex 12 जून 2018, 22:23