dengeceteris
Altın Üye
- Katılım
- 21 Aralık 2019
- Mesajlar
- 204
- Excel Vers. ve Dili
- Office 2016
- Altın Üyelik Bitiş Tarihi
- 15-06-2025
Arkadaşlar herkese günaydın: Aşağıda görmüş olduğunuz kodlar var. Bunları Korhan bey yazmıştı. gayet hızlı çalışan bir kod kendisine tekrar tşk ederim. (Ben Sorgu = yazan kısmın devamını buraya alırken kısalttım kalabalık olmaması için)
Makromda bir biçimlendirmeye ihtiyacım var. Kaynak sayfalarda bazı alanlar formüllü. Bunları çekerken metin formatında atıyor ama hepsini öyle yapmıyor. sütunun biri normal gelirken bir diğeri sayı formatı haricinde geliyor. (Ara başlıklar ise metin olanlar hiç gelmiyor.) Ben en alta şöyle bir ekleme yapıyorum ama olmuyor. Birde eksi karakterli olanları parantez içine almak istiyorum. Bunu hücre biçimlendirmesinden ayarlayabiliyorum. Ama kod çalışınca kayboluyor. Eklediğim kod: Range("A02:AA100" & Rows.Count).NumberFormat = "#,##0.00"
Sub Amortisman_Aktar_Munferit()
Dim Dosya As String, Baglanti As Object, Sorgu As String
Dim Kayit_Seti As Object, Sayfa As Worksheet, Zaman As Double
Dim Hedef_Sayfalar As Variant, Kaynak_Sayfalar As Variant, x As Byte
Set Baglanti = CreateObject("AdoDb.Connection")
Dosya = ThisWorkbook.Path & Application.PathSeparator & "AMORTİSMAN_MUNFERİT.xlsm"
Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
Dosya & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
Hedef_Sayfalar = Array("AMORTİSMAN_MUNFERİT")
Kaynak_Sayfalar = Array("MAHSUP")
For x = 0 To UBound(Hedef_Sayfalar)
Set Sayfa = Sheets(CStr(Hedef_Sayfalar(x)))
Sayfa.Range("A2:AQ" & Rows.Count).ClearContents
Sorgu = "Select [HESAP KODLARI 1],[DÖNEM BAŞI BAKİYE 1] ,[DÖNEM GİDERİ 1],[ÇIKIŞLAR 1],[DÖNEM SONU BAKİYE 1] From [" & Kaynak_Sayfalar(x) & "$]"
Set Kayit_Seti = Baglanti.Execute(Sorgu)
Sayfa.Range("A2").CopyFromRecordset Kayit_Seti
Sayfa.Columns.AutoFit
Next
Kayit_Seti.Close
Baglanti.Close
Set Kayit_Seti = Nothing
Set Baglanti = Nothing
Range("S35:U" & Rows.Count).NumberFormat = "#,##0.00"
End Sub
Makromda bir biçimlendirmeye ihtiyacım var. Kaynak sayfalarda bazı alanlar formüllü. Bunları çekerken metin formatında atıyor ama hepsini öyle yapmıyor. sütunun biri normal gelirken bir diğeri sayı formatı haricinde geliyor. (Ara başlıklar ise metin olanlar hiç gelmiyor.) Ben en alta şöyle bir ekleme yapıyorum ama olmuyor. Birde eksi karakterli olanları parantez içine almak istiyorum. Bunu hücre biçimlendirmesinden ayarlayabiliyorum. Ama kod çalışınca kayboluyor. Eklediğim kod: Range("A02:AA100" & Rows.Count).NumberFormat = "#,##0.00"
Sub Amortisman_Aktar_Munferit()
Dim Dosya As String, Baglanti As Object, Sorgu As String
Dim Kayit_Seti As Object, Sayfa As Worksheet, Zaman As Double
Dim Hedef_Sayfalar As Variant, Kaynak_Sayfalar As Variant, x As Byte
Set Baglanti = CreateObject("AdoDb.Connection")
Dosya = ThisWorkbook.Path & Application.PathSeparator & "AMORTİSMAN_MUNFERİT.xlsm"
Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
Dosya & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
Hedef_Sayfalar = Array("AMORTİSMAN_MUNFERİT")
Kaynak_Sayfalar = Array("MAHSUP")
For x = 0 To UBound(Hedef_Sayfalar)
Set Sayfa = Sheets(CStr(Hedef_Sayfalar(x)))
Sayfa.Range("A2:AQ" & Rows.Count).ClearContents
Sorgu = "Select [HESAP KODLARI 1],[DÖNEM BAŞI BAKİYE 1] ,[DÖNEM GİDERİ 1],[ÇIKIŞLAR 1],[DÖNEM SONU BAKİYE 1] From [" & Kaynak_Sayfalar(x) & "$]"
Set Kayit_Seti = Baglanti.Execute(Sorgu)
Sayfa.Range("A2").CopyFromRecordset Kayit_Seti
Sayfa.Columns.AutoFit
Next
Kayit_Seti.Close
Baglanti.Close
Set Kayit_Seti = Nothing
Set Baglanti = Nothing
Range("S35:U" & Rows.Count).NumberFormat = "#,##0.00"
End Sub