Kapalı Dosyalarda Veri ve Sütun Silmek

[murat_fidan]

Değerli arkadaşlar AÇIK kitap isimli sayfamın "A" sütununa yazdığım TC kimlik numaralarını kapalı olan çalışma kitaplarında bulup TC kimlik numaralarının bulunduğu satırları komple silmek istiyorum. Yine Aynı zamanda bu işlemi yaparken Kapalı dosyalardaki G,H,I,J,K,L,M,N,Q,R,V sütunlarınıda silsin istiyorum. Kapalı olan çalışma kitapları aynı formatta bulunmaktadır. Kapalı olan çalışma kitabı sayım yaklaşık 50 adettir. Saygılarımla

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Test()
    Dim K1 As Workbook, S1 As Worksheet
    Dim File_Path As String, My_File As String
    Dim K2 As Workbook, S2 As Worksheet
    Dim TC_No As Range, My_Data As Variant
    Dim X As Long, Last_Row As Long, Record_Count As Long
    
    Application.ScreenUpdating = False
    
    Set K1 = ThisWorkbook
    Set S1 = K1.Sheets("Sayfa1")
    
    File_Path = K1.Path
    
    My_File = Dir(File_Path & "\*.xls*")
    
    While My_File <> ""
        If My_File <> K1.Name Then
            Set K2 = Workbooks.Open(File_Path & "\" & My_File)
            Set S2 = K2.Sheets(1)
            
            S2.Range("G:N,Q:R,V:V").EntireColumn.Delete
            
            Last_Row = WorksheetFunction.Max(3, S1.Cells(S1.Rows.Count, 1).End(3).Row)
            My_Data = S1.Range("A2:A" & Last_Row).Value
            
            For X = LBound(My_Data, 1) To UBound(My_Data, 1)
                If My_Data(X, 1) <> "" Then
                    Set TC_No = S2.Range("B:B").Find(My_Data(X, 1), , , xlWhole)
                    If Not TC_No Is Nothing Then
                        TC_No.EntireRow.Delete
                        Record_Count = Record_Count + 1
                    End If
                End If
            Next
            
            K2.Close True
        End If
        My_File = Dir
    Wend
    
    Set TC_No = Nothing
    Set K1 = Nothing
    Set S1 = Nothing
    Set K2 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox Record_Count & " adet kayıt silinmiştir.", vbInformation
End Sub

 

[murat_fidan]

Deneyiniz.

Option Explicit

Sub Test()
    Dim K1 As Workbook, S1 As Worksheet
    Dim File_Path As String, My_File As String
    Dim K2 As Workbook, S2 As Worksheet
    Dim TC_No As Range, My_Data As Variant
    Dim X As Long, Last_Row As Long, Record_Count As Long
   
    Application.ScreenUpdating = False
   
    Set K1 = ThisWorkbook
    Set S1 = K1.Sheets("Sayfa1")
   
    File_Path = K1.Path
   
    My_File = Dir(File_Path & "\*.xls*")
   
    While My_File <> ""
        If My_File <> K1.Name Then
            Set K2 = Workbooks.Open(File_Path & "\" & My_File)
            Set S2 = K2.Sheets(1)
           
            S2.Range("G:N,Q:R,V:V").EntireColumn.Delete
           
            Last_Row = WorksheetFunction.Max(3, S1.Cells(S1.Rows.Count, 1).End(3).Row)
            My_Data = S1.Range("A2:A" & Last_Row).Value
           
            For X = LBound(My_Data, 1) To UBound(My_Data, 1)
                If My_Data(X, 1) <> "" Then
                    Set TC_No = S2.Range("B:B").Find(My_Data(X, 1), , , xlWhole)
                    If Not TC_No Is Nothing Then
                        TC_No.EntireRow.Delete
                        Record_Count = Record_Count + 1
                    End If
                End If
            Next
           
            K2.Close True
        End If
        My_File = Dir
    Wend
   
    Set TC_No = Nothing
    Set K1 = Nothing
    Set S1 = Nothing
    Set K2 = Nothing
    Set S2 = Nothing
   
    Application.ScreenUpdating = True
   
    MsgBox Record_Count & " adet kayıt silinmiştir.", vbInformation
End Sub

Korhan Bey "A" sütununa 60 TC kimlik numarası yazıp 3000 satırlık bir data üzerinde denedim. Bu satırı
S2.Range("G:N,Q:R,V:V").EntireColumn.Delete
bu şekilde S2.Range("G:H,I:J,K:L,M:N,Q:R,V").EntireColumn.Delete düzenledim. Ancak görselini paylaştığım hatayı alıyorum.

 

[Haluk]

Niye düzenleme ihtiyacını duydunuz ki?

Korhan Beyin önerisindeki sütunlar zaten sizin tarif etmeye çalıştığınız sütunları kapsıyor... Eksiği ya da fazlası yok.

Sizinkinde hata, sanırım en sonda V:V kısmını eksik yazmanızdan kaynaklanıyor.

.

 

[murat_fidan]

Niye düzenleme ihtiyacını duydunuz ki?

Korhan Beyin önerisindeki sütunlar zaten sizin tarif etmeye çalıştığınız sütunları kapsıyor... Eksiği ya da fazlası yok.

Sizinkinde hata, sanırım en sonda V:V kısmını eksik yazmanızdan kaynaklanıyor.

.

Haluk bey onuda denedim görüntüsünü paylaştığım hatayı veriyor

 

[murat_fidan]

Açık kitabın A sütununa 60 TC kimlik numarası yazıp 20 kapalı dosyada (kapalı dosyadaki veri sayıları ortalama 80 satır) denedim sorunsuz çalıştı. Ancak bu kapalı dosyalardan bir tanesindeki veri sayısını 3000 satır yapınca yukarıda belirttiğim hatayı verdi.

 

[Korhan Ayhan]

Merhaba,

Şimdi paylaştığınız dosyalardan birinde satır adedini 4.000 adede kadar çoğalttım. Önerdiğim kodu denedim ben hiçbir hata ile karşılaşmadım.

Sizin asıl dosyalarınızda belki bilmediğimiz farklı bir durum olabilir.

 

[murat_fidan]

Merhaba,

Şimdi paylaştığınız dosyalardan birinde satır adedini 4.000 adede kadar çoğalttım. Önerdiğim kodu denedim ben hiçbir hata ile karşılaşmadım.

Sizin asıl dosyalarınızda belki bilmediğimiz farklı bir durum olabilir.

Sorunu çözemedim ama şuan için işimi fazlasıyla gördü teşekkürler Korhan bey