Şartlı Sütun Silmek

[5353]

İyi günler
Ekteki dosyada gözüken PUAN sütunlarının hepsini silsin. Başlıkla TUTAR kalsın.. yani B ve C sütunundaki BAYRAM ÇALIŞMADI ve TUTAR, B sütünü na yazılacak.
Teşekkürler.

 

[5353]

Sonuçta böyle sağa doğru devam edecek PUAN sütunu silinecek hepsi

 

[Korhan Ayhan]

Deneyiniz.

Sub Sil()
    For X = Cells(2, Columns.Count).End(1).Column To 2 Step -2
        Baslik = Cells(1, X - 1)
        Cells(1, X - 1).EntireColumn.Delete
        Cells(1, X - 1) = Baslik
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[5353]

Çok teşekkür ederim. Sadece ilk sütunlardaki sicil no adı ve soyadı ayrımı da olsa tam süper olur.. zorsa olmasa da olur. Tek tuşa kolaylığa hep alıştık

Söyle ki Sicil no Adı ve Soyadı söyle olsa
Sicil no Adı ve Soyadı Bayram Çalışmadı .......
550487 Mustafa KURT 455,10 ........

Burada bazı kişilerin adı 2 kelime Mevlut Ali Kandemir gibi.

 

[Korhan Ayhan]

Deneyiniz.

Sub Sil()
    Sutun = 3
    If Range("A2") = "ADI SOYADI" Then
        Sutun = 2
        Columns("B:B").Insert Shift:=xlToRight
        Application.DisplayAlerts = False
        Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(7, 1)), TrailingMinusNumbers:=True
        Application.DisplayAlerts = True
        Range("A2:B2") = Array("SİCİL NO", "ADI SOYADI")
    End If
    
    For X = Cells(2, Columns.Count).End(1).Column To Sutun Step -2
        Baslik = Cells(1, X - 1)
        If Cells(2, X - 1) = "PUAN" Then
            Cells(1, X - 1).EntireColumn.Delete
            Cells(1, X - 1) = Baslik
        End If
    Next

    ActiveSheet.UsedRange.Borders.LineStyle = 1
    Cells.EntireColumn.AutoFit

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[5353]

Deneyiniz.

Sub Sil()
    Sutun = 3
    If Range("A2") = "ADI SOYADI" Then
        Sutun = 2
        Columns("B:B").Insert Shift:=xlToRight
        Application.DisplayAlerts = False
        Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(7, 1)), TrailingMinusNumbers:=True
        Application.DisplayAlerts = True
        Range("A2:B2") = Array("SİCİL NO", "ADI SOYADI")
    End If
   
    For X = Cells(2, Columns.Count).End(1).Column To Sutun Step -2
        Baslik = Cells(1, X - 1)
        If Cells(2, X - 1) = "PUAN" Then
            Cells(1, X - 1).EntireColumn.Delete
            Cells(1, X - 1) = Baslik
        End If
    Next

    ActiveSheet.UsedRange.Borders.LineStyle = 1
    Cells.EntireColumn.AutoFit

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Süper

ne diyeyim.. Size ve sevdiklerinize mevladan Sağlık mutluluk diliyorum .

 

[Korhan Ayhan]

Amin. Bilmukabele..