belli bir formata göre düzenleme

[onur3466]

Merhaba Arkadaşlar,

Ben sol tarafta cihaz çıkış formatını sağ taraftaki istenen format düzyinde istemekteyim. sol taraf ölçümden ölçüme satır sayısı değişsede sağ taraftaki gibi düzenleyebilirmiyiz her seferinde?

 

[Muzaffer Ali]

Merhaba.

1- Sütunların yerleri değiştirilsin istiyorsunuz bunu sütunları kes yada kopyala yapıştır yöntemi ile yapabilirsiniz.
2- Satırların yerlerini de değiştirmişsiniz. Satırları neye göre listelemek istiyorsunuz? Ölçüt nedir?

 

[onur3466]

örnek olarak Muzaffer bey,
RowDirection , TestDirectionNum ve row 1 iken step adımları sırasıyla işlesin ama SpecimenValueAdjusted ölçütlere göre 100 den başlayarak 2000 e gelmiş 2000 den başlamış 5000 e gelmiş ve buna göre MasterValueAdjusted değerleri eşleştirme yapmasını istemekteyim.

RowDirection , TestDirectionNum 1 ve row 2 iken yine aynı döngü olsun, yine aynı şekilde row 3 iken de aynı döngü devam etsin.
sonra RowDirection 1 TestDirectionNum 2 olduğunda yukarının aynısı şekilde döngü olması lazım.

 

[Muzaffer Ali]

Deneyiniz.

 

[onur3466]

elinize sağlık çok güzel olmuş muzaffer bey
fakat işlemi şu şekilde değiştirdiğimde 1000 değerini en alta atıyor

 

[onur3466]

muzaffer bey tamamdır çok teşekkür ederim . eğer izniniz olursa bana buradan çok yardımızı dokundu sizin veya ailenizden birinin kara kalem çalışmasını yapmak isterim bende sosyal medya adınızı paylaşırsanız

 

[onur3466]

aşağıdaki çıktı formatınma ekstra sütınlar geldiğinde makroda neyi değiştirmem gerekli peki ?

 

[onur3466]

aslında cihazın orjinal çıktısı ekteki gibidir muzaffer bey . ben bu şekilde yaptım ama hata veriyor

 

[Muzaffer Ali]

Aşağıdaki kodu kullanın.

Private Sub btnDuzenle_Click()
    Dim syf As Worksheet
    Dim Bak As Variant
    Dim Say As Long
    
    Say = Cells(Rows.Count, "A").End(xlUp).Row
    Set syf = ThisWorkbook.Worksheets.Add
    Application.ScreenUpdating = False
    
    For Each Bak In Array("MasterValueAdjusted", "SpecimenValueAdjusted", "Step", "Row", "TestDirectionNum", "RowDirection")
        syf.Columns(1).Insert
        Columns(Rows(1).Find(what:=Bak, lookat:=xlWhole).Column).Copy syf.Range("A1")
    Next
    
    For Bak = 5 To 1 Step -1
        If Bak <> 4 Then
            With syf.Sort
                .SortFields.Clear
                .SortFields.Add2 Key:=Range(Columns(Bak).Address), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange Range("A1:F" & Say)
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End If
    Next
End Sub

 

[onur3466]

yaptım ama ilk yaptığınıza göre sıralama çok düzensiz oldu

 

[Muzaffer Ali]

Sadece başlık satırının yerini düzenledim.
Önceki 2. satıra göreydi burada 1. satıra göre değiştirdim. Başka bir değişiklik yapmadım.

Kodun yaptığı işlemi anlatayım.
1- Sütunlar kopyalanıyor.
2- Alfabetik sıralama yapılıyor.
- Önce 5. sütun sıralanıyor, sonra 3, 2 ve 1. sütunlar sırasıyla sıralanıyor. 4. ve 6. sütunlarda sıralama yapılmıyor.
İlk gönderdiğiniz örnek dosyada bu şekilde doğru sonuç dönüyordu.

Bu sıralamayı elinizle yapıp kontrol edin. Hangi sütunlar hangi sırada sıralanması gerektiğini söylerseniz ona göre değiştirebilirim.

 

[onur3466]

muzaffer bey eline sağlık gerçekten tüm kombinasyonlarda denicem zaten .
tek istediğim şuan yeni sayfa açmadan datalar sayfasına aktarması verileri

 

[Muzaffer Ali]

Set syf = ThisWorkbook.Worksheets.Add

Yukardaki satırı silin aşağıdakini kopyalayın

    Set syf = ThisWorkbook.Worksheets("Datalar")

foto

 

[onur3466]

muzaffer bey çok teşekkür ederim
onuryildiz1453@gmail.com resim atarsanız karakalem yapıp iletirim size 1 hafta da

 

[Muzaffer Ali]

muzaffer bey çok teşekkür ederim
onuryildiz1453@gmail.com resim atarsanız karakalem yapıp iletirim size 1 hafta da

Rica ederim.
Gerek yoktu böyle bir şeye ama oğlum için olabilir belki.

 

[onur3466]

severek yaparım

 

[onur3466]

merhaba muzaffer bey, formulü tekrardan uyguladığımda datalar kısmında sarı renkli alan fazladan geliyor

 

[Muzaffer Ali]

Bu kodu deneyin.

Private Sub btnDuzenle_Click()
    Dim syf As Worksheet
    Dim Bak As Variant
    Dim Say As Long
    Dim Kolon As Integer
    
    Say = Cells(Rows.Count, "A").End(xlUp).Row
    Set syf = ThisWorkbook.Worksheets("datalar")
    Application.ScreenUpdating = False
    syf.Range("A:F").ClearContents
    
    For Each Bak In Array("RowDirection", "TestDirectionNum", "Row", "Step", "SpecimenValueAdjusted", "MasterValueAdjusted")
        Columns(Rows(1).Find(what:=Bak, lookat:=xlWhole).Column).Copy syf.Columns(Kolon + 1)
        Kolon = syf.Cells(1, Columns.Count).End(xlToLeft).Column
    Next
    
    For Bak = 5 To 1 Step -1
        If Bak <> 4 Then
            With syf.Sort
                .SortFields.Clear
                .SortFields.Add2 Key:=Range(Columns(Bak).Address), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange Range("A1:F" & Say)
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub

 

[onur3466]

çok teşekkür ederim muzaffer bey çalıştı

 

[Muzaffer Ali]

Örnek dosyadaki sonuç sayfasında mavi kısım her zaman 12 satır ve 3 kolondan mı oluşuyor.
aynı durum turuncu kısım in de geçerli mi?