Veri Azaltma

zuzzu · 13 Mayıs 2011

Arkadaslar merhaba,

Sheet1'den Sheet2'ye kopyalama islemi yapiyorum. Kopyalama sirasinda Sheet1'in ilk 37 satirini direkt kopyaliyorum.
39. satirdan itibaren ise, satir sayisini 4 arttirarak, 5 satirda 1 satiri kopyalatiyorum. Böylelikle ilk bölümdeki aciklama kismini kaybetmemis oluyorum ve ana verilerimin de sayisini azaltarak, grafik icin daha uygun veriler elde ediyorum. Ancak bunu yaparken ScreenUpdating sorunu yasiyorum. Nereye yazdiysam olmadi. Ve bütün kopyalama islemi sona erene kadar ekranda mouse sürekli mesgul gözüküyor ve uzun süre bekliyorum.

1) Sizce Application.ScreenUpdating=False/True kismini nereye eklemeliyim?
2) Myrange1 ve myrange2 yi tanimlarken belirli hücreler kullanmak istemiyorum.
myrange1=A1den baslayip SON kolona kadar
myrange2=A1den baslayip SON satira kadar --> seklinde ifade etmek istiyorum. Sanirim Row.Count, Column.Count xlEnd seklinde ifadeler kullanmam lazim. Buna hakim degilim.
3) Son olarak kodlarin sondan 6. satirinda Sheet2 yazarak, yine, belirli bir adres vermek istemiyorum. Belki ben bu makroyu uyguladigimda zaten dosyada 1 Sheet2 sayfasi olabilir. Bu Makroyu YENI bir Sheet'te calistir demenin yolu var midir?

Cok cok tesekkür ederim.

Iyi calismalar!

Sub Makro1()
'
' Makro1 Makro
'
Application.ScreenUpdating = False ‘????????????????

Dim h As Long 'kolonsayici
Dim i As Long 'satirsayici "Sheet1"
Dim j As Long 'satirsayici "Sheet2"

Dim kolonsay As Integer, Dim satirsay as Integer
Dim baslangicsatir As Integer, baslangickolon As Integer
Dim sonkolon As Integer, sonsatir As Integer
Dim durmasatiri As Integer
Dim baslangicsatir2 As Integer

Set myrange1 = Worksheets("Sheet1").Range("A1:BZ39")
Set myrange2 = Worksheets("Sheet1").Range("A1:A65000")

kolonsay = WorksheetFunction.CountA(myrange1)
satirsay = WorksheetFunction.CountA(myrange2)

baslangickolon = 1
baslangicsatir = 1
durmasatiri = 37
baslangicsatir2 = 39

sonsatir = baslangicsatir + satirsay - 1
sonkolon = baslangickolon + kolonsay - 1

' 1. satirdan 37.satira kadar tüm kolonlari Sheet1‘den Sheet2‘ye kopyalar
j = 1
For i = baslangicsatir To durmasatiri
For h = baslangickolon To sonkolon
Worksheets("Sheet2").Cells(j, h).Value = Worksheets("Sheet1").Cells(i, h).Value
Next h
j = j + 1

Next i

’39.satirdan sonuncu satira kadar tüm kolonlari Sheet1’den Sheet2’ye kopyalar
j = 39
For i = baslangicsatir2 To sonsatir
For h = baslangickolon To sonkolon
Worksheets("Sheet2").Cells(j, h).Value = Worksheets("Sheet1").Cells(i, h).Value
Next h
i = i + 4
j = j + 1
Next i
End Sub

Ferhat Pazarçevirdi · 13 Mayıs 2011

Merhabalar,

1) Mouse'un, -kod çalışırken- meşgul görünmesinin sebebi, döngülerden kaynaklanıyor.

Kodlarınızın yapısını şöyle değiştirirseniz, bütün herşey bir anda olup biter. Mouse'un hareketini hissetmezsiniz bile.

Döngü yerine, Excel'in "copy (destination)" metodunu kullanmak size büyük avantaj sağlar.

2) myRange'lerin kullanımına gerek yok ama kodlarda, son sutun ve son satırın bulunmasına yönelik 2 alternatif verdim. İnceleyiniz.

3) wks2 adındaki (değişken) sheet; kod çalışırken workbook'a eklenir. Bu sizin tabirinizle sheet2'dir ama aynı zamanda değildir

Kod:

Sub Aralik_Kopyalama()

    Dim wks1 As Worksheet
    Dim wks2 As Worksheet
    Dim lSonSutun As Long
    Dim lSonSatir As Long
    
    Set wks1 = Sheets("Sheet1")
    
    With wks1
[COLOR="Green"]        'Son satır ve son sütunun bulunması
        'İki yöntemden birini seçin
        '1)[/COLOR]
        lSonSutun = .Cells(1, 256).End(xlToLeft).Column
        lSonSatir = .Cells(65536, 1).End(xlUp).Row
        
[COLOR="green"]        '2)[/COLOR]
        lSonSutun = .UsedRange.Columns.Count
        lSonSatir = .UsedRange.Rows.Count
    
[COLOR="green"]        'Yeni bir sayfa ekleniyor[/COLOR]
        Set wks2 = Sheets.Add(, Sheets(Sheets.Count), , 1)
        
[COLOR="green"]        'Excel'in otomatik hesaplama özelliğini kapat[/COLOR]
        Application.Calculation = xlCalculationManual
        
[COLOR="green"]        'Kopyalama işlemleri yapılıyor[/COLOR]
        
[COLOR="green"]        '1. satirdan 37.satira kadar tüm kolonlari Sheet1‘den Sheet2‘ye kopyalar[/COLOR]
        .Range("A1:BZ37").Copy wks2.Range("A1:BZ37")
    
[COLOR="Green"]        '39.satirdan sonuncu satira kadar tüm kolonlari Sheet1’den Sheet2’ye kopyalar[/COLOR]
        .Range("A39:BZ" & lSonSatir).Copy wks2.Range("A39:BZ" & lSonSatir)
    
[COLOR="green"]        'Excel'in otomatik hesaplama özelliği aktif[/COLOR]
        Application.Calculation = xlCalculationAutomatic
    
    End With
    
    Set wks1 = Nothing
    Set wks2 = Nothing
    
End Sub

.

zuzzu · 13 Mayıs 2011

Ferhat Bey,

Dediginiz gibi ekran yenilenmesi isi sonunda durdu ve makro cok hizli calisiyor. cok cok tesekkür ederim. Tek kalan nokta ise;

'39.satirdan sonuncu satira kadar tüm kolonlari Sheet1’den Sheet2’ye kopyalar
.Range("A39:BZ" & lSonSatir).Copy wks2.Range("A39:BZ" & lSonSatir)

Yazili kisimda 39. satirdan itibaren baslayarak 39.,44.,49.,54.,59.,64.,69.,... yani satir sayisini 4er arttirarak yazdirmam icin ne eklemem gerekiyor?

Cok tesekkür ederim

Ferhat Pazarçevirdi · 13 Mayıs 2011

Yani, Sheet1'deki 39, 44, 49, 54 vs satırları, sheet2'de yine 39, 44, 49, 54 vs hücrelere denk getirmek istiyorsanız şöyle bir kod işinizi görebilir.

Döngüdeki satır numarası, her seferinde, 5 birim artırılarak kopyalama işlemi tamamlanır.

Kod:

Sub Aralik_Kopyalama()

    Dim wks1 As Worksheet
    Dim wks2 As Worksheet
    Dim lSonSutun As Long
    
    Dim lSonSatir As Long
    Dim lIlkSatir As Long
    Dim i As Integer
    Dim j As Integer
    
    lIlkSatir = 39
    
    Set wks1 = Sheets("Sheet1")
    
    With wks1
[COLOR="Green"]        'Son satır ve son sütunun bulunması
        'İki yöntemden birini seçin
        '1)[/COLOR]
        lSonSutun = .Cells(1, 256).End(xlToLeft).Column
        lSonSatir = .Cells(65536, 1).End(xlUp).Row
        
[COLOR="green"]        '2)[/COLOR]
        lSonSutun = .UsedRange.Columns.Count
        lSonSatir = .UsedRange.Rows.Count
    
[COLOR="green"]        'Yeni bir sayfa ekleniyor[/COLOR]
        Set wks2 = Sheets.Add(, Sheets(Sheets.Count), , 1)
        
[COLOR="green"]        'Excel'in otomatik hesaplama özelliğini kapat[/COLOR]
        Application.Calculation = xlCalculationManual
        
[COLOR="green"]        'Kopyalama işlemleri yapılıyor[/COLOR]
        
[COLOR="green"]        '1. satirdan 37.satira kadar tüm kolonlari Sheet1den Sheet2ye kopyalar[/COLOR]
        .Range("A1:BZ37").Copy wks2.Range("A1:BZ37")
    
        For j = 0 To 10000
            i = j * 5
            If lSonSatir > lIlkSatir + i Then
[COLOR="green"]                '39.satirdan sonuncu satira kadar tüm kolonlari Sheet1den Sheet2ye kopyalar[/COLOR]
                .Range("A" & lIlkSatir + i & ":BZ" & lIlkSatir + i).Copy wks2.Range("A" & lIlkSatir + i & ":BZ" & lIlkSatir + i)
            Else
                Exit For
            End If
        Next j
[COLOR="green"]        'Excel'in otomatik hesaplama özelliği aktif[/COLOR]
        Application.Calculation = xlCalculationAutomatic
    
    End With
    
    Set wks1 = Nothing
    Set wks2 = Nothing
    
End Sub

zuzzu · 13 Mayıs 2011

Ferhat Bey,

Yapmak istedigim:

Sheet1 Sheet2
39 --> 39
44 --> 40
49 --> 41
54 --> 42
Yani Sheet1den 5er 5er aldiklarini, sira ile Sheet2ye alt alta yazmasi

Ferhat Pazarçevirdi · 13 Mayıs 2011

İsteğinizin bu yönde olacağı aklıma gelmedi değil ama şansımı denemek istedim. Murphy yine haklı çıktı.

O halde, şu kodu deneyin.

Kaynak (Kopyalanan) aralığın satır nosu 5-5 artarken, Destination (Hedef) aralığınki 1-1 artırılarak sorun çözülmüştür (bkz: "k" değişkeni)

Kod:

Sub Aralik_Kopyalama()

    Dim wks1 As Worksheet
    Dim wks2 As Worksheet
    Dim lSonSutun As Long
    
    Dim lSonSatir As Long
    Dim lIlkSatir As Long
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    
    lIlkSatir = 39
    k = lIlkSatir
    
    Set wks1 = Sheets("Sheet1")
    
    With wks1
[COLOR="Green"]        'Son satır ve son sütunun bulunması
        'İki yöntemden birini seçin
        '1)[/COLOR]
        lSonSutun = .Cells(1, 256).End(xlToLeft).Column
        lSonSatir = .Cells(65536, 1).End(xlUp).Row
        
[COLOR="green"]        '2)[/COLOR]
        lSonSutun = .UsedRange.Columns.Count
        lSonSatir = .UsedRange.Rows.Count
    
[COLOR="green"]        'Yeni bir sayfa ekleniyor[/COLOR]
        Set wks2 = Sheets.Add(, Sheets(Sheets.Count), , 1)
        
[COLOR="green"]        'Excel'in otomatik hesaplama özelliğini kapat[/COLOR]
        Application.Calculation = xlCalculationManual
        
[COLOR="green"]        'Kopyalama işlemleri yapılıyor
        
        '1. satirdan 37.satira kadar tüm kolonlari Sheet1den Sheet2ye kopyalar[/COLOR]
        .Range("A1:BZ37").Copy wks2.Range("A1:BZ37")
    
        For j = 0 To 10000
            i = j * 5
            If lSonSatir > lIlkSatir + i Then
[COLOR="green"]                '39.satirdan sonuncu satira kadar tüm kolonlari, 5 satır atlayarak, Sheet1den Sheet2ye altlalta kopyalar[/COLOR]
                .Range("A" & lIlkSatir + i & ":BZ" & lIlkSatir + i).Copy wks2.Range("A" & k & ":BZ" & k)
            Else
                Exit For
            End If
            k = k + 1
        Next j
[COLOR="green"]        'Excel'in otomatik hesaplama özelliği aktif[/COLOR]
        Application.Calculation = xlCalculationAutomatic
    
    End With
    
    Set wks1 = Nothing
    Set wks2 = Nothing
    
End Sub

zuzzu · 13 Mayıs 2011

Ferhat Bey,

Epey ugrastim ama sonunda basardim

))

Tam istedigim gibi oldu.
Tabiki de sizin sayenizde. Ancak degiskenleri anlamak, nasil kopyaladigini anlamak epey vaktimi aldi.

Cok cok tesekkür ederim size =)))

Kolay gelsin!

Veri Azaltma

zuzzu

Ferhat Pazarçevirdi

Özel Üye

zuzzu

Ferhat Pazarçevirdi

Özel Üye

zuzzu

Ferhat Pazarçevirdi

Özel Üye

zuzzu