Sütun Silme

cinarbx · 3 Ağustos 2022

Makroyu çalıştırdığımda bulunan sayfada "S" sütunu "AK" sütunu ve "AL" sütunu hariç diğer sütunları silen bir vba kodu nasıl olabilir acaba ? sildikten sonra bu 3 kolonu yan yana A B C kolonuna gelmesi gerek

Tevfik_Kursun · 3 Ağustos 2022

Merhaba,
işinizi görür umarım.

Kod:

Sub Makro1()
    Columns("T:AJ").Select
    Selection.Delete Shift:=xlToLeft
    Columns("A:R").Select
    Selection.Delete Shift:=xlToLeft
End Sub

Kolay gelsin

cinarbx · 3 Ağustos 2022

Tevfik_Kursun' Alıntı:
Merhaba,
işinizi görür umarım.

Kod:

Sub Makro1() Columns("T:AJ").Select Selection.Delete Shift:=xlToLeft Columns("A:R").Select Selection.Delete Shift:=xlToLeft End Sub

Kolay gelsin

AL sütunundan sonra da veriler Mevcut onların da tamamının silinmesini istiyorum.
Bir diğer konu da yazmış olduğunuz kod çalışıyor sırasıyla S sütununu A ya AK yi B ye ve AL yi C sütununa getiriyor evet bu işlemi yaptıkdan sonra B ve C hücresindeki verilerin yerlerinin de değişmesi gerekiyor.

Tevfik_Kursun · 3 Ağustos 2022

Merhaba,
İlk mesajınızı yazdıktan sonra okumadığınızı düşünüyorum.

Kod:

Sub Makro2()
    Columns("S:S").Select
    Selection.Copy
    Columns("A:A").Select
    ActiveSheet.Paste
    
    Columns("AL:AL").Select
    Selection.Copy
    Columns("B:B").Select
    ActiveSheet.Paste
    
    Columns("AK:AK").Select
    Selection.Copy
    Columns("C:C").Select
    ActiveSheet.Paste
    
    Columns("D:ZZ").Select
    Selection.Delete Shift:=xlToLeft
    Application.CutCopyMode = False
End Sub

cinarbx · 3 Ağustos 2022

Tevfik_Kursun' Alıntı:

Merhaba,
İlk mesajınızı yazdıktan sonra okumadığınızı düşünüyorum.

Kod:

Sub Makro2()
    Columns("S:S").Select
    Selection.Copy
    Columns("A:A").Select
    ActiveSheet.Paste
  
    Columns("AL:AL").Select
    Selection.Copy
    Columns("B:B").Select
    ActiveSheet.Paste
  
    Columns("AK:AK").Select
    Selection.Copy
    Columns("C:C").Select
    ActiveSheet.Paste
  
    Columns("D:ZZ").Select
    Selection.Delete Shift:=xlToLeft
    Application.CutCopyMode = False
End Sub

Öncelikle teşekkürr ederim zahmetiniz için ekte paylaştığım dosyaya bakınız ben bu yolla makro kaydederek yaptım.

Sizden ricam ekteki dosyayı ben çalıştırmak istediğimde açık olan excel sayfaları donuyor bunun sebebi belkide fazla hücre tarıyor diye olabilir sizden ricam dosyayı çalıştırıp sizde de donma yapıyor mu yapmıyorsa nasıl bir çıktı veriyor ekrana bunu benimle paylaşır mısınız?

deneme.xlsm

drive.google.com

AdemCan · 3 Ağustos 2022

Alternatif kod.

Kod:

Sub test()
Application.ScreenUpdating = False
c = Cells(1, Columns.Count).End(1).Column

For i = 1 To c
    If Cells(1, i).Column <> 19 And Cells(1, i).Column <> 37 And Cells(1, i).Column <> 38 Then
        Cells(1, i).Clear
    End If
Next i

Rows(1).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete

Columns("C:C").Cut
Columns("B:B").Insert Shift:=xlToRight

sonA = Cells(Rows.Count, "A").End(3).Row
For i = sonA To 2 Step -1
    If Cells(i, "B").Value = 0 Then
        Rows(i).Delete
    End If
Next i

Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

Ayrıca https://excel.web.tr/threads/veri-aktarimi.202417/ bu konudaki paylaşım için geri dönüş yapmadınız.

cinarbx · 3 Ağustos 2022

AdemCan' Alıntı:

Alternatif kod.

Kod:

Sub test()
Application.ScreenUpdating = False
c = Cells(1, Columns.Count).End(1).Column

For i = 1 To c
    If Cells(1, i).Column <> 19 And Cells(1, i).Column <> 37 And Cells(1, i).Column <> 38 Then
        Cells(1, i).Clear
    End If
Next i

Rows(1).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete

Columns("C:C").Cut
Columns("B:B").Insert Shift:=xlToRight

sonA = Cells(Rows.Count, "A").End(3).Row
For i = sonA To 2 Step -1
    If Cells(i, "B").Value = 0 Then
        Rows(i).Delete
    End If
Next i

Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

Ayrıca https://excel.web.tr/threads/veri-aktarimi.202417/ bu konudaki paylaşım için geri dönüş yapmadınız.

Teşekkürler emeğinize sağlık önceki kod da bu kod da çok iyi çalışamakta teşekkür ederim takrardan.

AdemCan · 3 Ağustos 2022

Rica ederim.

cinarbx · 3 Ağustos 2022

AdemCan' Alıntı:
Rica ederim.

Şöyle bir şey mümkün müdür acaba anlatıyorum:

Elimde A1 hücresinden BS753 hücresine kadar bağzı hücreleri dolu bağzı hücreleri boş olmak üzere sayfa adı Veri olan bir tablo mevcut üstteki kod gereksiz verileri sildikten sonra benim istediğim 3 veri sütununu bırakıyor ya ben makroyu çalıştırdığımda bu 3 sütun bir yan sayfada Sonuc adındaki sayfada gözükse ?

Yani kodu veri sayfasındaki verilere göre işleyip kalan 3 sütunu Sonuc sayfasına yazacak

AdemCan · 3 Ağustos 2022

Kodu güncelledim.
Bi hatırlatma yapmak istiyorum. Sütun silme işlemi çözüldüğü için yeni sorularınızı yeni konu açarak sormanız forum kullanıcıları açısından daha uygun olacaktır.

Kod:

Sub test()
Application.ScreenUpdating = False
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Veri"): Set s2 = Sheets("Sonuç")

c = s1.Cells(1, Columns.Count).End(1).Column

For i = 1 To c
    If s1.Cells(1, i).Column <> 19 And s1.Cells(1, i).Column <> 37 And s1.Cells(1, i).Column <> 38 Then
        s1.Cells(1, i).Clear
    End If
Next i

s1.Rows(1).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete

s1.Columns("C:C").Cut
s1.Columns("B:B").Insert Shift:=xlToRight

sonA = s1.Cells(Rows.Count, "A").End(3).Row
For i = sonA To 2 Step -1
    If s1.Cells(i, "B").Value = 0 Then
        s1.Rows(i).Delete
    End If
Next i
sonA = s1.Cells(Rows.Count, "A").End(3).Row

son = s2.Cells(Rows.Count, "A").End(3).Row
s2.Range("A1:C" & son).Clear
s1.Range("A1:C" & sonA).Copy s2.Range("A1")

s1.Cells.EntireColumn.AutoFit
s2.Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

cinarbx · 4 Ağustos 2022

AdemCan' Alıntı:

Kodu güncelledim.
Bi hatırlatma yapmak istiyorum. Sütun silme işlemi çözüldüğü için yeni sorularınızı yeni konu açarak sormanız forum kullanıcıları açısından daha uygun olacaktır.

Kod:

Sub test()
Application.ScreenUpdating = False
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Veri"): Set s2 = Sheets("Sonuç")

c = s1.Cells(1, Columns.Count).End(1).Column

For i = 1 To c
    If s1.Cells(1, i).Column <> 19 And s1.Cells(1, i).Column <> 37 And s1.Cells(1, i).Column <> 38 Then
        s1.Cells(1, i).Clear
    End If
Next i

s1.Rows(1).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete

s1.Columns("C:C").Cut
s1.Columns("B:B").Insert Shift:=xlToRight

sonA = s1.Cells(Rows.Count, "A").End(3).Row
For i = sonA To 2 Step -1
    If s1.Cells(i, "B").Value = 0 Then
        s1.Rows(i).Delete
    End If
Next i
sonA = s1.Cells(Rows.Count, "A").End(3).Row

son = s2.Cells(Rows.Count, "A").End(3).Row
s2.Range("A1:C" & son).Clear
s1.Range("A1:C" & sonA).Copy s2.Range("A1")

s1.Cells.EntireColumn.AutoFit
s2.Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

deneme.xlsm

Veri Buyer i.d.,Supplier i.d.,transmission no. old,transmission no. new,Message date,Buyer Organization,Org. Name Customer,Buyer plant i.d.,Plant Name,Unloading Point,Point of Consumption,warehouse,Packaging type 1,filling quantity 1,Packaging type 2,filling quantity 2,Packaging type 3,filling q...

docs.google.com

merhabalar ekte dosya bıraktım istediğim şeyi tekrar daha açık ifade ediyorum belki üstteki mesajda tam ifade edememiş olabilirim :

veri sayfasında bütün veriler bulunuyor sonuc sayfasındaki makroya bastığım anda silme işlemi ve B sütunuyla C sütunundaki yer değiştirme işlemi yapılacak ve bu 3 sütun Sonuc sayfasında gözükecek. İstediğim şey bu yardımcı olursanız sevinirim. Sizin yazmış olduğunuz kod yine veri sayfasına yazdırıyor.

AdemCan · 4 Ağustos 2022

Merhaba, ben kod içinde sayfa ismini Sonuç olarak belirttim, dosyanızdaki sayfa ismine göre
Set s2 = Sheets("Sonuç") satırını
Set s2 = Sheets("Sonuc") olarak değiştiriniz.

cinarbx · 5 Ağustos 2022

AdemCan' Alıntı:
Merhaba, ben kod içinde sayfa ismini Sonuç olarak belirttim, dosyanızdaki sayfa ismine göre
Set s2 = Sheets("Sonuç") satırını
Set s2 = Sheets("Sonuc") olarak değiştiriniz.

Dediğinizi yaptım ve kod sorunsuz çalıştı üzerinde biraz daha ilerleme yapıp bir döngü içinde şartlı kod yazmak istedim ekte bıraktığım dosyada da görebilirsiniz ancak bir türlü if değeri çalışmadı bu konuda yardımcı olur musunuz?

deneme.xlsm

drive.google.com

AdemCan · 5 Ağustos 2022

Merhaba, 10 numaralı mesajda belirttiğim gibi yeni sorularınız için yeni konu açınız.

AdemCan' Alıntı:
Bi hatırlatma yapmak istiyorum. Sütun silme işlemi çözüldüğü için yeni sorularınızı yeni konu açarak sormanız forum kullanıcıları açısından daha uygun olacaktır.

cinarbx · 5 Ağustos 2022

AdemCan' Alıntı:
Merhaba, 10 numaralı mesajda belirttiğim gibi yeni sorularınız için yeni konu açınız.

aynı proje üzerinde bir işlem olduğu için burdan devam edebiliriz diye düşündüm

AdemCan · 5 Ağustos 2022

Aynı proje fakat, konu başlıkları farklı olduğu için forum kullanıcılarının faydalanması açısından, farklı konuların yeni başlıklarda açılması daha uygun olur.

cinarbx · 5 Ağustos 2022

AdemCan' Alıntı:
Aynı proje fakat, konu başlıkları farklı olduğu için forum kullanıcılarının faydalanması açısından, farklı konuların yeni başlıklarda açılması daha uygun olur.

Anladım demek istediğinizi eğer komutunun VBA da çalışmama sorunu olarak yeni başlıkta gönderdim

Sütun Silme

cinarbx

Tevfik_Kursun

cinarbx

Tevfik_Kursun

cinarbx

deneme.xlsm

AdemCan

Altın Üye

cinarbx

AdemCan

Altın Üye

cinarbx

AdemCan

Altın Üye

cinarbx

deneme.xlsm

AdemCan

Altın Üye

cinarbx

deneme.xlsm

AdemCan

Altın Üye

cinarbx

AdemCan

Altın Üye

cinarbx