• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro ile kenarlık

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
M

muratkul

Katılım
27 Ocak 2009
Mesajlar
243
Excel Vers. ve Dili
EXCEL2003,TÜRKÇE
Merhabalar,
Elimde bir excel tablosu ve makro mevcut.Fakat bu makro A SUTUNUndaki verilere göre işlem yapıyor. Bu makroyu c sutunundaki verilere göre güncellemek istiyorum. Yardımcı olabilirmiisniz.
Kod: 
Sub ÇERÇEVE_KENARLIK_BRN()
Columns("A:S").Borders.LineStyle = xlNone: son = [A65536].End(3).Row
With Range("A1:S" & son).Borders: .LineStyle = xlContinuous: .ColorIndex = 16: .Weight = xlThin: End With
For brn = 2 To [A65536].End(3).Row
ilk = WorksheetFunction.Match(Cells(brn, 1), Range("A1:A" & [A65536].End(3).Row), 0)
son = ilk + WorksheetFunction.CountIf(Range("A1:A" & [A65536].End(3).Row), Cells(brn, 1)) - 1
alan = "A" & ilk & ":S" & son: Range(alan).Select
With Selection.Borders(xlEdgeLeft): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeTop): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeBottom): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeRight): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
brn = son: Next: Cells(1, 1).Activate: MsgBox "KENARLIKLAR TAMAM"
End Sub
 

Ekli dosyalar

Selamlar,

Aşağıdaki şekilde değiştirip deneye bilir misiniz.

Kod: 
Sub ÇERÇEVE_KENARLIK_BRN()
Columns("A:S").Borders.LineStyle = xlNone: son = [A65536].End(3).Row
With Range("a1:S" & son).Borders: .LineStyle = xlContinuous: .ColorIndex = 16: .Weight = xlThin: End With
For brn = 2 To [C65536].End(3).Row
ilk = WorksheetFunction.Match(Cells(brn, 1), Range("A1:A" & [A65536].End(3).Row), 0)
son = ilk + WorksheetFunction.CountIf(Range("A1:A" & [A65536].End(3).Row), Cells(brn, 1)) - 1
alan = "c" & ilk & ":S" & son: Range(alan).Select
With Selection.Borders(xlEdgeLeft): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeTop): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeBottom): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeRight): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
brn = son: Next: Cells(1, 1).Activate: MsgBox "KENARLIKLAR TAMAM"
End Sub
 
Kod: 
Sub ÇERÇEVE_KENARLIK_BRN()
Columns("A:S").Borders.LineStyle = xlNone: son = [C65536].End(3).Row
With Range("A1:S" & son).Borders: .LineStyle = xlContinuous: .ColorIndex = 16: .Weight = xlThin: End With
For brn = 2 To [C65536].End(3).Row
ilk = WorksheetFunction.Match(Cells(brn, 3), Range("C1:C" & [C65536].End(3).Row), 0)
son = ilk + WorksheetFunction.CountIf(Range("C1:C" & [C65536].End(3).Row), Cells(brn, 3)) - 1
alan = "A" & ilk & ":S" & son: Range(alan).Select
With Selection.Borders(xlEdgeLeft): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeTop): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeBottom): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeRight): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
brn = son: Next: Cells(1, 1).Activate: MsgBox "KENARLIKLAR TAMAM"
End Sub
 
Vedat özer ve askm çok teşekkür ederim. Tam istediğim gibi.
Yalnız Size zahmet olmazsa ekteki tabloya bu makro ayarlayabilirmisiniz.
 

Ekli dosyalar

Kodları aşağıdaki şekilde deneyin.
Kod: 
Sub ÇERÇEVE_KENARLIK_BRN()
Columns("A:S").Borders.LineStyle = xlNone: son = [C65536].End(3).Row
With Range("A1:S" & son).Borders: .LineStyle = xlContinuous: .ColorIndex = 16: .Weight = xlThin: End With
For brn = 10 To [C65536].End(3).Row
ilk = WorksheetFunction.Match(Cells(brn, 3), Range("C1:C" & [C65536].End(3).Row), 0)
son = ilk + WorksheetFunction.CountIf(Range("C1:C" & [C65536].End(3).Row), Cells(brn, 3)) - 1
alan = "A" & ilk & ":S" & son: Range(alan).Select
With Selection.Borders(xlEdgeLeft): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeTop): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeBottom): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeRight): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
brn = son: Next: Cells(1, 1).Activate: MsgBox "KENARLIKLAR TAMAM"
End Sub
 
çok teşekkür ederim. Elinize sağlık.Tam istediğim gibi.
 
Rica ederim. Kolay gelsin.
 
askm kusura bakmayın ama bir ricam daha olacak. yardımcı olabilirmisiniz.
Kdv rap. dosyasnı açtığınızda hesaplamaların yanında tarih var. Bu tarihi H9 sütunundaki tarih ile birlikte çalışmasını istiyorum. Yani filtre yapıp 04-1-2018 yaptığımda f2 sütunundaki tarihte 04-01-2018 olsun...06-01-2018 yaptığımda f2 de 06-01-2018 olsun.
 
Tek bir tarih değilde birden çoklu tarih seçilirse problem olur o şekilde. Kod hata verecektir.
 
O zaman filtreleme olayını spitbutton ile yapalım. Spit button değiştikçe değer de değişir. Manuel de yazabilirsiniz. Yani filtreyi de kaldırabilirsiniz.
 
Teşekkürler askm.
Spitbuttonu anlamadım. OLmazsa tarihleri mauel yazarım artık.
Herşey için teşekkürler.
 
Merhaba askm yine ben. Benden bıktınız belki. özür diliyerek bir ricam daha olacak.
Ekteki tabloma göre bu Spitbuttonu nasıl ayarlayacağız. ben tabloda ençok şirket,temsilci ıd ve fatura tarihlerine göre alt toplam için filtre kullanıyorum. Bunu spitbutton olarak ayarlayabilirmiyiz. Eğer ayaralarız derseniz çok mutlu olurum, buda filtre gibi tarihte değilde mesela temsilcı ıd, çoklu seçim yapabiliyormuyuz.
 
Spit button artırma azaltma işlemine yarar. Birer birer artar ve azalır. Çoklu seçim yapılmaz.
 
Neyse artık boşverin askm. Rapor istediğim gibi çalışıyor tarihi de filtreyle yaparım artık. Çok sağolun.
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Geri
Üst