Satırdaki Şekillerin tarih sırasına getirilmesi

[ynmcan]

Merhaba,
Ekteki şeker takip dosyasında, şeker değerlerini UserForm ile sayfadaki çizelgeye aktarıyorum.
Girilen değerlere göre ilgili hücrelere değişik renkli şekiller geliyor.
Girilen değerleri Tarih sırasına göre sıralıyor.
Ancak satırlardaki şeker değerleri tarih sırasına gelirken, şekiller aynı satırda kalıyor tarih sırasına gelmiyor.
Bu işlemi Modul2 de bulunan “sıralama” adlı makro ile yapıyorum
Makroyu
CommandButton1_Click() 'VERİLERİ ŞEKER ÖLÇÜM ÇİZELGESİNE AKTAR
CommandButton5_Click() 'SEÇİLİ VERİYİ DÜZENLE
CommandButton6_Click() 'SEÇİLİ VERİLE SİL
Kodlarının son satırlarına yazarak kullanıyorum
Ayrıca değerlere göre gelen renkli şekillerin makrosu modul1 de
Bu makro Private Sub Worksheet_Change(ByVal Target As Range) içinndeki koddadır.
Şekillerin tarih sırasına gelmemesi sorununu nasıl çözebilirim.

 

[ynmcan]

Sorunu, sıralama makrosuna aşağıdaki kodu ekleyerek kısmen çözdüm.

     For sut1 = 4 To 14
     For son1 = 10 To 24
          syf.Cells(son1, sut1 + 20).Value = syf.Cells(son1, sut1).Value
          syf.Cells(son1, sut1).Value = syf.Cells(son1, sut1 + 20).Value
     Next son1
     Next sut1
     syf.Range("x10:ah24").Value = ""

Bu kod ile satırları tarihlere göre sıraladıktan sonra çizelgedeki verileri sayfadaki başka hücrelere atıp tekrar çizelgeye aktarıyorum.

Bu sayede Worksheet_Change(ByVal Target As Range) olayı içindeki renlendirme için kullandığım makro çalışıyor.

Ancak bu tüm hücreleri sırayla tek tek aktardığı için bu işlemler yapılırken sayfada görünüyor.

Buda azda olsa yapılan işlemi yavaşlatıyor hem de göze hoş görünmüyor.

Bunu nasıl daha verimli hale getirebilirim.

Dosyamın son hali ekte

 

[ynmcan]

Aşağıdaki for döngüsünde hücreleri kullandığımdan dosyamı yavaşlatıyor
bu koda hücre yerine array kullanma imkanı varmı.

Kod modül2 içinde yazılı "Sırala" makrosu içinde

"Sırala" makrosunu
CommandButton1_Click() 'VERİLERİ ŞEKER ÖLÇÜM ÇİZELGESİNE AKTAR
CommandButton5_Click() 'SEÇİLİ VERİYİ DÜZENLE
CommandButton6_Click() 'SEÇİLİ VERİLE SİL
Kodlarının son satırlarına yazarak kullanıyorum.

     For sut1 = 4 To 14
     For son1 = 10 To 24
          syf.Cells(son1, sut1 + 20).Value = syf.Cells(son1, sut1).Value
          syf.Cells(son1, sut1).Value = syf.Cells(son1, sut1 + 20).Value
     Next son1
     Next sut1
     syf.Range("x10:ah24").Value = ""