A sutunu boş olan hücrelerin silinmesi

[seranonet]

Forumda bu tip konular mevcut inceledim ama hepsi satırları siliyor ben satır sayısının sabit kalmasını istiyorum sadece a sutnun dolu olan satırların tamamının içini boşalmasını istiyorum

 

[snx111]

Sub Makro1()
' aralık için
   Range("A5:A20").Select
    Selection.ClearContents
End Sub

Sub Makro2()
'
'tüm sütun için
'

'
    Columns("A:A").Select
    Selection.ClearContents
End Sub

istediğiniz sütundaki istediğniz veri için sütunun adı ; örnek "a" yazın; dolu olan satırlar için "*" yazılıcak !!!!

Sub KillRows()
     
    Dim MyRange As Range, DelRange As Range, C As Range
    Dim MatchString As String, SearchColumn As String, ActiveColumn As String
    Dim FirstAddress As String, NullCheck As String
    Dim AC
     
     'Extract active column as text
    AC = Split(ActiveCell.EntireColumn.Address(, False), ":")
    ActiveColumn = AC(0)
     
    SearchColumn = InputBox("Enter Search Column - press Cancel to exit sub", "Row Delete Code", ActiveColumn)
     
    On Error Resume Next
    Set MyRange = Columns(SearchColumn)
    On Error GoTo 0
     
     'If an invalid range is entered then exit
    If MyRange Is Nothing Then Exit Sub
     
    MatchString = InputBox("Enter Search string", "Row Delete Code", ActiveCell.Value)
    If MatchString = "" Then
        NullCheck = InputBox("Do you really want to delete rows with empty cells?" & vbNewLine & vbNewLine & _
        "Type Yes to do so, else code will exit", "Caution", "No")
        If NullCheck <> "Yes" Then Exit Sub
    End If
     
    Application.ScreenUpdating = False
     
     'to match the WHOLE text string
    Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole)
     'to match a PARTIAL text string use this line
     'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlpart)
     'to match the case and of a WHOLE text string
     'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)
     
    If Not C Is Nothing Then
        Set DelRange = C
        FirstAddress = C.Address
        Do
            Set C = MyRange.FindNext(C)
            Set DelRange = Union(DelRange, C)
        Loop While FirstAddress <> C.Address
    End If
     
     'If there are valid matches then delete the rows
    If Not DelRange Is Nothing Then DelRange.EntireRow.Delete
     
    Application.ScreenUpdating = True
     
End Sub

 

[Murat OSMA]

Bulduğunuz kodlardaki Delete metodu yerine, ClearContents metodunu kullanınız...

 

[Murat OSMA]

Bu arada, konu ismi ile mesaj içeriği tutarsız...

 

[seranonet]

ben sanırım istediğimi anlatamadım kusura bakmayın A sutunuda dolu olan hücrelerin satırındaki tüm verilerin silinmesini istiyorum sadece a sutunundaki verilerin değil hata bende kusura bakmayın

 

[snx111]

Sub KillRows()
     
    Dim MyRange As Range, DelRange As Range, C As Range
    Dim MatchString As String, SearchColumn As String, ActiveColumn As String
    Dim FirstAddress As String, NullCheck As String
    Dim AC
     
     'Extract active column as text
    AC = Split(ActiveCell.EntireColumn.Address(, False), ":")
    ActiveColumn = AC(0)
     
    SearchColumn = InputBox("Enter Search Column - press Cancel to exit sub", "Row Delete Code", ActiveColumn)
     
    On Error Resume Next
    Set MyRange = Columns(SearchColumn)
    On Error GoTo 0
     
     'If an invalid range is entered then exit
    If MyRange Is Nothing Then Exit Sub
     
    MatchString = InputBox("Enter Search string", "Row Delete Code", ActiveCell.Value)
    If MatchString = "" Then
        NullCheck = InputBox("Do you really want to delete rows with empty cells?" & vbNewLine & vbNewLine & _
        "Type Yes to do so, else code will exit", "Caution", "No")
        If NullCheck <> "Yes" Then Exit Sub
    End If
     
    Application.ScreenUpdating = False
     
     'to match the WHOLE text string
    Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole)
     'to match a PARTIAL text string use this line
     'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlpart)
     'to match the case and of a WHOLE text string
     'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)
     
    If Not C Is Nothing Then
        Set DelRange = C
        FirstAddress = C.Address
        Do
            Set C = MyRange.FindNext(C)
            Set DelRange = Union(DelRange, C)
        Loop While FirstAddress <> C.Address
    End If
     
     'If there are valid matches then delete the rows
    If Not DelRange Is Nothing Then DelRange.EntireRow.Delete
     
    Application.ScreenUpdating = True
     
End Sub

 

[seranonet]

teşekkürler