Dosya kendiliğinden Büyüdü!!

[shenko]

Daha önce sitenin de yardımıyla yapmış olduğum excell dosyasını 2007 senesi için yenilemek istedim, fakat dosya 823kb iken birden 5700kb çıktı.

Yenileme esnasında yaptığım tek şey eski dataları silip boş hala getirmek. Makroları çalıştırmadan farklı kaydettiğimde herhangi birşey yok ama makroları çalıştırdıktan sonra boş dosya 5700kb oluyor. Neden olabilir??

 

[İdris SERDAR]

Macrolar pek çok yere formül, hücre formatı gibi bir şeyler yapıyor olmasın.

 

[shenko]

Evet Sayın Yurttas makrolar bazı hücrelerin formatını değiştiriyor. Ama eski dosyam çok daha fazla doluydu ama yinede böyle bişey hiç olmadı!

 

[İdris SERDAR]

Kodları kopyalayıp buraya koyun bakalım. Belki bir çaresini bulan olur.

 

[shenko]

Sub auto_open()
Sener.Show 0
End Sub
Sub SENER_Click()
ActiveWindow.LargeScroll ToRight:=-1
Range("B7:S65536").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-87
Range("U7").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("U7").Select
Range("T2").Select
son = [T65536].End(3).Row
Range("T7:AL" & son).Select
Selection.Font.Name = "Arial"
Selection.Sort Key1:=Range("w7"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Cells(7, 23).Font.Name = "Arial Black"
For x = 7 To son - 1
If Cells(x, 23) <> Cells(x + 1, 23) Then Cells(x + 1, 23).Font.Name = "Arial Black"
Next
son = [w65536].End(3).Row
For x = 7 To son
If Range("W" & x).Font.Name = "Arial Black" Then
Range("T" & x - 1 & ":AL" & x - 1).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If

Next
MsgBox "ALICILAR'A GÖRE SIRALANDI!"
End Sub

 

[İdris SERDAR]

Range("B7:S65536").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-87
Range("U7").Select
ActiveSheet.Paste

Benim gözüme burası çarptı.


Yani b7:s65536'nın tümünü kopyalattırmak zorundamısınız?

 

[shenko]

Tümünü değil aslında bana B ile S columları arasındaki dolu hücreler lazım.

 

[shenko]

Sanırım sorunumun neden kaynaklandığını bilen yok.

Peki

Range("B7:S65536").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-87
Range("U7").Select
ActiveSheet.Paste

buradaki b7:s65536 aralığını b7:s500 e düşürdüğümde kodda değiştirmem gereken yer var mı???

Bide kod sayfamdaki makrolarda değişiklik yapamıyorum neden olabilir?

 

[Levent Menteşoğlu]

San&#305;r&#305;m sorunumun neden kaynakland&#305;&#287;&#305;n&#305; bilen yok.

Peki

Range("B7:S65536").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-87
Range("U7").Select
ActiveSheet.Paste

buradaki b7:s65536 aral&#305;&#287;&#305;n&#305; b7:s500 e d&#252;&#351;&#252;rd&#252;&#287;&#252;mde kodda de&#287;i&#351;tirmem gereken yer var m&#305;???

Bide kod sayfamdaki makrolarda de&#287;i&#351;iklik yapam&#305;yorum neden olabilir?

Sadece kodu k&#305;saltmak i&#231;in a&#351;a&#287;&#305;daki gibi d&#252;zenleyebilirsiniz.

Range("B7:S500").Copy Range("U7")

 

[shenko]

Peki kodun geriye kalan aşağıdaki kısmını buna göre nasıl düzeltebilirim??

Range("T2").Select
son = [T65536].End(3).Row
Range("T7:AL" & son).Select
Selection.Font.Name = "Arial"
Selection.Sort Key1:=Range("w7"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Cells(7, 23).Font.Name = "Arial Black"
For x = 7 To son - 1
If Cells(x, 23) <> Cells(x + 1, 23) Then Cells(x + 1, 23).Font.Name = "Arial Black"
Next
son = [w65536].End(3).Row
For x = 7 To son
If Range("W" & x).Font.Name = "Arial Black" Then
Range("T" & x - 1 & ":AL" & x - 1).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If

Next
MsgBox "ALICILAR'A GÖRE SIRALANDI!"
End Sub