Makro ile verilen kritere göre veri dağılımı.

[leumruk]

Selamlar...
Ekte belirttiğim dosyada girdiğim verilerin belirtilen kritere göre yerlerinin değişmesi gerekiyor.
Gerekli açıklamalar ekte.
İlgilenirseniz sevinirim.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub duzelt()
Dim deg(25)
For a = 9 To [a65536].End(3).Row
If Cells(a, "a") = "A" Then GoTo 10
For b = 1 To 25
deg(b) = Cells(a, b + 5)
Next
sut = WorksheetFunction.Match(Cells(a, "a"), [sayfa2!2:2], 0)
For c = 1 To 25
Cells(a, c + 5) = deg(Sheets("sayfa2").Cells(c + 2, sut))
Next
10 Next
End Sub

 

[leumruk]

Sayın L.Menteşeoğlu,
Öncelikle teşekkür ederim. Dağıtma işlemini yapıyor. Fakat ikinci tıklamada da yer değiştiriyor. Bu değiştirme işlemi yine tabloya göre oluyor; ancak verinin yerinin bir defa değişmesi gerek. Örneğin düşeyara fonksiyonunda olduğu gibi. Bunun da bir çaresi var mı? Bir de soru sayısı değişebilir. işlemi herhangi bir hücreden aldığı değere göre yapabilir mi? Yani 25 sınırlamasını kaldırabilir miyiz?
Saygılar...

 

[Levent Menteşoğlu]

Aşağıdaki gibi bir mantıkla kodun tek bir sefer çalışması sağlanabilir. 25 sınırlaması elbette kaldırılabilir. Bu işlem sayfa2 için kolaydır. Ancak sayfa1deki tablonun yapısı buna uygun değil. Yani 25ten fazla soru olduğunu sayfa1de nasıl koda tanıtacaksınız?

Sub duzelt()
Dim deg(25)
For a = 9 To [a65536].End(3).Row
If Cells(a, "a") = "A" Or Cells(a, "af") <> "" Then GoTo 10
For b = 1 To 25
deg(b) = Cells(a, b + 5)
Next
sut = WorksheetFunction.Match(Cells(a, "a"), [sayfa2!2:2], 0)
For c = 1 To 25
Cells(a, c + 5) = deg(Sheets("sayfa2").Cells(c + 2, sut))
Next
Cells(a, "af") = "*"
10 Next
End Sub

 

[leumruk]

Belli sayıda tablo oluşturacağım. 20 soruluk, 25 soruluk, 40 soruluk ve 50 soruluk. Bunlardan zaten 20 ve 25'liği kullanacağım. Diğerleri istisnai durumlarda kullanılacak. Bir makro aracılığı ile kaç soru gireceksem o tabloyu ana sayfaya çağıracağım. Çağırma işemi sırasında soru sayısını belli bir hücreye yazmasını sağlayacağım. Mesela 20 soruluğu çağırdığımda belirlediğim hücrede 20 yazacak. Sayfa2'deki tablo içinde aynı şeyler söz konusu. 20 soruluğu çağırdığımda bu tabloda kayıt yerinden ana yerine gelecek vb...

 

[leumruk]

Levent hocam,
Kodlar için çok teşekkür ederim. Benim için önemi büyük. Çölde su bulmuş gibi oldum desem yeridir.
Bir ara bu kodların satırlarının yanına ne işlem yaptıklarını yazabilirseniz memnun olurum. Çünkü bu kodu farklı özellikteki tablolarda kullanacağım. Uyarlama yapabilmem için neyin neye yaradığını iyi bilmem lazım.
İyi geceler...

 

[dirsee]

Sayın leumruk,

İsteğiniz şu 2 yoldan biri ile yapılabilir.

1) Orjinal verileri değiştirmeden, yerleri değiştirilmiş verileri ayrı bir sayfalarda tutabilirsiniz. Yani orjinal veriler (sayfa1), sıralama anahtarı (sayfa2) ve yerleri değiştirilmiş veriler (sayfa3) olur. Bu durumda, makro, Sayfa1'deki verileri, Sayfa2'teki yer değiştirme anahtarını kullanarak, Sayfa3'e yerleştirir. Bu durumun avantajı, orjinal değerlerinizi hiç bir zaman kaybetmemiş olmanızdır. Her türlü çalışma, Sayfa3'teki işlenmiş veriler üzerinden yapılır. Herhangi bir nedenle geri dönmek çok kolay olur.

2) Sayda1'deyken, Ekle-Ad-Tanımla menüsünü kullanarak değeri 0 (sıfır) olan bir ad (mesela "Koruma") oluşturursunuz.
Makro çalışmaya başladığında, bu değeri kontrol eder.
Eğer değer 0 ise, değiştirme işlemini yapar ve işlemler tamamlandığında bu değeri "1" ile değiştirir. Böylece makro tekrar çalıştırıldığında bu değer 0'dan farklı olacağı için, "Veriler daha önce değiştirilmiş" mesajı verir ve işlem yapmadan durur. Yani makro şöyle olur.

Sub duzelt()
Dim deg(25)
If ActiveWorkbook.Names("Koruma").RefersToR1C1 = "=0" Then
     For a = 9 To [a65536].End(3).Row
           If Cells(a, "a") = "A" Or Cells(a, "af") <> "" Then GoTo 10
           For b = 1 To 25
                deg(b) = Cells(a, b + 5)
           Next
           sut = WorksheetFunction.Match(Cells(a, "a"), [sayfa2!2:2], 0)
           For c = 1 To 25
                Cells(a, c + 5) = deg(Sheets("sayfa2").Cells(c + 2, sut))
           Next
           Cells(a, "af") = "*"
      10 Next
     ActiveWorkbook.Names.Add Name:="Koruma", RefersToR1C1:="=1"
Else
     MsgBox "Bu liste daha önce değiştirilmiş."
End If
End Sub

 

[Levent Menteşoğlu]

Sn dirsee

2 nolu önerinizdeki mantık çok güzel tebrik ederim. Yalnız bu uygulamanın tek sakıncası var oda alta yeni veriler eklendiğinde makronun işlem yapmayacak olmasıdır. Bana göre 1 nolu öneriniz verilerin korunması açısından çok mantıklıdır.

 

[dirsee]

İltifatınız için teşekkür ederim Sn. Menteşoğlu.

Benim kişisel tercihim de işlenmiş datanın ayrı bir yerde ele alınmasıdır.

2. yönteme, bazı eklemeler yapılarak daha esnek hale getirmek mümkün. Mesela, kullanıcıya "İşlenmiş dataları tekrar işlemek istiyor musunuz?" diye sorulabilir. Veya, "Kontrol" değerini resetleme seçeneği verilebilir.

Yine de orjinal "Ham" datalar üzerinde değişiklik yapmak, bence tercih edilmemesi gereken bir yol.

Saygılarımla,

Dirse ERDEM

 

[leumruk]

Syn. dirsee,
Yöntemlerinizden ikiside gerçekten mantıklı ve orjinal. İkisinin de değerlendirmesini yaptım ve 1 nolu yöntemin uygun olduğuna kanaat getirdim. Orjinal verinin bir kenarda durması avantajlı olacaktır. Makroyu ne kadar çalıştırırsam çalıştırayım, bana aynı sonucu verecektir. Benim istediğimde buydu zaten.
İlginizden ötürü teşekkür ederim.
saygılar...