veri eşleme (koordinat)

T

tahirturan

Katılım
26 Temmuz 2007
Mesajlar
20
Excel Vers. ve Dili
2003 türkçe
Merhaba değerli arkadaşlar,

elimde bir veri kütüğü var. yapısı şöyle: noktano, y, x, z
bunlar CAD tabanlı bir programdan gelen noktalar. ancak aynı y ve x değerine sahip birden fazla nokta var. ben bunları y ve x kriterine göre işleyip sadece nokta numaralarını ayrı bir yere eşlemek istiyorum.

örnek:

NoktaNo y x z
101 1000 1000 0
312 1000 1000 0
344 1000 1000 0
513 1103 1234 0
655 1103 1234 0

sonuç:
A B C D E
101 312 344
513 655

yardımcı olabilir misiniz?
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Özet bir dosya yollasaydınız daha iyi olurdu.:cool:
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Verdiğiniz örnekte syıların gerçek değerleri ile görüntülenen değerleri arasında fark olduğunu sanırım biliyorsunuz... Yani, umduğunuzdan daha fazla nokta çeşidi ile karşılaşacaksınız.

Aşağıdaki gibi bir kod kullanabilirsiniz. Kopyalama usulü kodu kullanırsanız, öncelikle referanslardan Microsoft Activex Data Object Recordset X.X Library kütüphanesi işaretlenmelidir.

Örnek dosyayı da inceleyiniz.

Kod: 
Sub Noktalari_Belirle()
    Dim rs As ADOR.Recordset
    Dim rng As Range
    Dim strYdegeri As String
    Dim strXdegeri As String
    Dim iStr As Integer
    Dim iStn As Integer
    
    Set rs = New ADOR.Recordset
    
    Columns("G:AA").Delete
    With rs
        With .Fields
            .Append "NoktaAdi", adChar, 50
            .Append "y", adDouble
            .Append "x", adDouble
        End With
        
        .CursorLocation = adUseClient
        .CursorType = adOpenForwardOnly
        .Open
        
        For Each rng In Range("A2:C11").Cells
            If rng.Column = 1 Then
                .AddNew
                .Fields(0) = CStr(rng)
            Else
                .Fields(rng.Column - 1) = IIf(IsNumeric(rng), rng, 0)
            End If
        Next
        
        .MoveFirst
        iStr = 1: iStn = 9
        
        Do Until .RecordCount = 0
            strYdegeri = Replace(.Fields(1).Value, ",", ".")
            
            strXdegeri = Replace(.Fields(2).Value, ",", ".")
            
            .Filter = "y=" & strYdegeri & " AND x=" & strXdegeri
            
            Cells(iStr, 7) = strYdegeri
            Cells(iStr, 8) = strXdegeri
            Cells(iStr, 9) = " değeri için şu noktalar :"
            
            Do Until .EOF
                iStn = iStn + 1
                Cells(iStr, iStn) = Trim(.Fields(0))
                .Delete adAffectCurrent
                .MoveNext
            Loop
            
            .Filter = adFilterNone
            If .RecordCount > 0 Then .MoveFirst
            iStr = iStr + 1
            iStn = 9
        Loop
            
    End With
    
    Columns("G:AA").EntireColumn.AutoFit
    
    Set rs = Nothing
        
End Sub
 

Ekli dosyalar

T

tahirturan

Katılım
26 Temmuz 2007
Mesajlar
20
Excel Vers. ve Dili
2003 türkçe
istediğim tam anlamıyla bu diyebilirim, çok teşekkürler. koordinat değerlerinin birbirinden farklı olduğunu biliyorum. peki burada sizce belirli bir tolerans değeri yazılamaz mı? örneğin tüm koordinatların virgülden sonra 2 haneye yuvarlanmış halini eşlemeye sokamaz mıyız?
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
tahirturan' Alıntı:
istediğim tam anlamıyla bu diyebilirim, çok teşekkürler. koordinat değerlerinin birbirinden farklı olduğunu biliyorum. peki burada sizce belirli bir tolerans değeri yazılamaz mı? örneğin tüm koordinatların virgülden sonra 2 haneye yuvarlanmış halini eşlemeye sokamaz mıyız?
Genişletmek için tıkla ...
Olabilir tabi ... Ben soruyu çözerken bu kararı veremeyeceğim için, kodlamaya böyle devam ettim.

Virgülden sonra iki basamak duyarlılıkla işlem yapmak istiyorsanız, kodun aşağıdaki bölümünü -kırmızı ile belirttiğim şekilde- düzeltiniz.

Kod: 
For Each rng In Range("A2:C11").Cells
    If rng.Column = 1 Then
        .AddNew
        .Fields(0) = CStr(rng)
    Else
        .Fields(rng.Column - 1) = IIf(IsNumeric(rng), [COLOR=red][B]Format(rng, "0.00")[/B][/COLOR] [COLOR=red][B]* 1[/B][/COLOR], 0)
    End If
Next
 
T

tahirturan

Katılım
26 Temmuz 2007
Mesajlar
20
Excel Vers. ve Dili
2003 türkçe
Ferhat Pazarçevirdi' Alıntı:
Olabilir tabi ... Ben soruyu çözerken bu kararı veremeyeceğim için, kodlamaya böyle devam ettim.

Virgülden sonra iki basamak duyarlılıkla işlem yapmak istiyorsanız, kodun aşağıdaki bölümünü -kırmızı ile belirttiğim şekilde- düzeltiniz.

Kod: 
For Each rng In Range("A2:C11").Cells
    If rng.Column = 1 Then
        .AddNew
        .Fields(0) = CStr(rng)
    Else
        .Fields(rng.Column - 1) = IIf(IsNumeric(rng), [COLOR=red][B]Format(rng, "0.00")[/B][/COLOR] [COLOR=red][B]* 1[/B][/COLOR], 0)
    End If
Next
Genişletmek için tıkla ...

çok teşekkürler. kısa bir sürede sorunumu çözdünüz. eğer fazla olmuyorsam bu konu hakkında son bir soru sormak isterim. düşünelim ki iki nokta arasında 1-2 cm fark var. birinin y değeri 1000.32, diğerinin y değeri ise 1000.33 .normalde 3-4 cm kadar aynı koordinat olarak kabul ediyorum ben. tabi yazdığımız kod haliyle 2 haneye göre grupluyor ve ikisini farklı satırlarda grupluyor. biz belirli bir tolerans vererek örneğin 3 cm nin içinde kalanları aynı değermiş gibi nasıl algılatırız?
teşekkürler
 
T

tahirturan

Katılım
26 Temmuz 2007
Mesajlar
20
Excel Vers. ve Dili
2003 türkçe
1000.32, bir noktanın y değeri yada x değeri. birim ise metre. yani 32 cm e tekamül ediyor. istediğim tam anlamıyla şu: 1000.32 gibi bir değer ile 1000.33 değerini otomatik aynı gruba alsın. yada şöyle düşünelim: koordinatları 5 cm de bir artıyormuş gibi düşünüp her 5 cm de bir tek grupta toplayalım. örneğin,

1000.32
1000.33
1000.31
1000.34 bu değerler 1000.30 yada 1000.35 gibi bir grupta yer alsın.

olayın içeriği de şu aslında. araziden gelen ölçüm değerleri var. haliyle her ölçün aynı olmuyor, ölçülen değere göre 3-5 cm değişik sonuçlar gelebiliyor. ben bunları -kendi vereceğim tolerans miktarına göre (5cm)- aynı grupta toplamak istiyorum.

teşekkürler
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Kodu aşağıdaki gibi revize ettim. Daha çok veri ile test şansım olmadığından siz çokça veri ile test ediniz. Muhtemelen isteğinizi karşılayacaktır.

Not : Kodun değiştirilen kısımlarını Kırmızı renk ile belirttim.

Kod: 
Sub Noktalari_Belirle()
    Dim rs As ADOR.Recordset
    Dim rng As Range
    Dim strYdegeri As String
    Dim strXdegeri As String
[COLOR=red]    Dim strSay As String[/COLOR]
    Dim iStr As Integer
    Dim iStn As Integer
    
    Set rs = New ADOR.Recordset
    
    Columns("G:AA").Delete
    With rs
        With .Fields
            .Append "NoktaAdi", adChar, 50
            .Append "y", adDouble
            .Append "x", adDouble
        End With
        
        .CursorLocation = adUseClient
        .CursorType = adOpenForwardOnly
        .Open
        
        For Each rng In Range("A2:C11").Cells
            If rng.Column = 1 Then
                .AddNew
                .Fields(0) = CStr(rng)
            Else
[COLOR=red]                If IsNumeric(rng) Then
                    
                    strSay = Format(rng, "0.00")
                    
                    If Right(strSay, 1) < 5 Then
                        strSay = Left(strSay, Len(strSay) - 1) & "0"
                    Else
                        strSay = Left(strSay, Len(strSay) - 1) & "5"
                    End If
                    
                    .Fields(rng.Column - 1) = strSay * 1
                
                End If[/COLOR]
            End If
        Next
        
        .MoveFirst
        iStr = 1: iStn = 9
        
        Do Until .RecordCount = 0
            strYdegeri = Replace(.Fields(1).Value, ",", ".")
            
            strXdegeri = Replace(.Fields(2).Value, ",", ".")
            
            .Filter = "y=" & strYdegeri & " AND x=" & strXdegeri
            
            Cells(iStr, 7) = strYdegeri
            Cells(iStr, 8) = strXdegeri
            Cells(iStr, 9) = " değeri için şu noktalar :"
            
            Do Until .EOF
                iStn = iStn + 1
                Cells(iStr, iStn) = Trim(.Fields(0))
                .Delete adAffectCurrent
                .MoveNext
            Loop
            
            .Filter = adFilterNone
            If .RecordCount > 0 Then .MoveFirst
            iStr = iStr + 1
            iStn = 9
        Loop
            
    End With
    
    Columns("G:AA").EntireColumn.AutoFit
    
    Set rs = Nothing
        
End Sub
 
T

tahirturan

Katılım
26 Temmuz 2007
Mesajlar
20
Excel Vers. ve Dili
2003 türkçe
gerçekten çok muhteşem yaa... bu kadar hızlı bir şekilde çözüm ürettiğiniz için sonsuz teşekkür ederim.

peki ben çalışma satırını nasıl değiştirebilirim? yani örneğin 15000 satırdan oluşan bir veri bloğunu işlemek için... kodlardaki a2:c11 ifadesini a2:c9000 ile değiştirdim ama hata üretiyo bir noktada... acemiliğimi maruz görün lütfen... profesyonelce bir iş bu...

bir de, sonuçları yeni bir sayfada yazdırmak istedim ama hata üretti...
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Ekteki örneği inceleyiniz.

Bu örnekte A-B-C-D sütunlarına ne kadar veri girerseniz (ister 300 ister 500 veya 9000) ona göre işlem yapar ... Sonuçları da, ayrı bir sayfada raporlar ...

Butona basarak, sonucu test ediniz.
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Üst