farklı koşullar ve sıralama

[modoste]

merhaba sayın hocalarım
ekli dosyamda sorumu ilettim.

hücrelerin kenarlarını kalın çizgi ile belirterek şekiller çizdim ve içlerine şeklin adını ve yanlarına sayılar yazdım
her şeklin içine bazen 1 tane bazen 2 bazende 3 tane aynı addan yazmak zorunda kaldım (projede olan değerler)
her şeklin kaç adet satırdan oluştuğu da sabit olmadığından ben sorumdaki sıralamayı çözemedim.

 

[Korhan Ayhan]

Sayfa üzerinde çizdiğini şekiller ile içindeki verilerin görsellik dışında bir bağlantısı olmadığı için formüllerle çözüm imkansız görünüyor.

Makro ile yatay düz çizgiler baz alınarak sütun bazında benzersiz veri listesi oluşturulabilir.

Bunun dışında aklıma başka bir çözüm yolu maalesef gelmedi.

 

[modoste]

sayın Hocam
2 haftadır bende bu imalatla ilgili autocad projesi çizilmiş imalatı takip edebilmek panelleri hesaplayabilmek adetleri bulabilmek adını
2 haftadır soru sordumda durdum aklıma gelen gelmeyen her yöntemi denemeye başladım

asıl olay burdan başlıyo yani her sıradaki panelleri benzersizde benzerlide sıralama ile ilgiliydi.

şekillerina ynısı elbet olamayacağından bend ekarelerle bir şekilde çizdim. dikkat ederseniz autocad de panel adı yazıyo en üst solda M4 karşında 2 var ama üstünde bir iki daha var. işte diğer ikiyide toplayabilmek için M4 bir defada yukarı yazdım. excelde öyle başladım. bayağı bi ilerledim

 

[Korhan Ayhan]

Ben ilk mesajınızda ki dosyaya göre çizgileri dikkate alarak listeyi oluşturan makroyu hazırladım. Kullanırım derseniz paylaşabilirim.

 

[modoste]

Kullanırım Korhan Hocam

 

[Korhan Ayhan]

Kendi dosyanıza uyarlarsınız.

Option Explicit

Sub Gruplari_Benzersiz_Listele()
    Dim X As Integer, Y As Long
    Dim Ilk_Satir As Long, Son_Satir As Long
    Dim Alan As Range, Veri As Range
    Dim Say As Long, Sutun As Integer
   
    Range("AA4:AC" & Rows.Count).ClearContents
   
    Sutun = 27
   
    For X = 5 To 13 Step 4
        ReDim Liste(1 To Rows.Count, 1 To 1)
       
        For Y = 4 To 45
            If Cells(Y, X).Borders(xlEdgeTop).LineStyle = xlContinuous Then
                If Ilk_Satir = 0 Then Ilk_Satir = Y
            End If
            If Cells(Y, X).Borders(xlEdgeBottom).LineStyle = xlContinuous Then
                If Ilk_Satir > 0 Then
                    If Son_Satir = 0 Then Son_Satir = Y
                End If
            End If
           
            If Ilk_Satir > 0 And Son_Satir > 0 Then
                With CreateObject("Scripting.Dictionary")
                    On Error Resume Next
                    Set Alan = Nothing
                    Set Alan = Range(Cells(Ilk_Satir, X), Cells(Son_Satir, X)).SpecialCells(xlCellTypeConstants, 23).Cells
                    On Error GoTo 0
                    If Not Alan Is Nothing Then
                        For Each Veri In Alan
                            If Not .Exists(Veri.Value) Then
                                Say = Say + 1
                                .Add Veri.Value, Nothing
                                Liste(Say, 1) = Veri.Value
                            End If
                        Next
                                           
                        .RemoveAll
                       
                        Ilk_Satir = 0
                        Son_Satir = 0
                    End If
                End With
            End If
        Next
        If Say > 0 Then
            Cells(4, Sutun).Resize(Say) = Liste
            Sutun = Sutun + 1
            Say = 0
            Erase Liste
        End If
    Next

    MsgBox "Liste oluşturulmuştur.", vbInformation
End Sub

 

[modoste]

Korhan Hocam ben bir sıra (4. sıra) daha ekledim
böyle 253 tane daha ekleyecem çok geniş bir alana kareleri çizecem tüm hepsine makro oluyor mu
makro kodlarından anlayamadığım için sordum hocam

 

[modoste]

sağa doğru devam ediyor böyle hocam

 

[Korhan Ayhan]

Evet makro ile olur.

Siz eklemelerinizi tamamlayın sonra dosyanızı paylaşın. Kodları revize ederiz. Ya da vermiş olduğum kodu kendi dosyanıza kendiniz uyarlayın. Tercih sizin.

 

[modoste]

Sayın Hocam Sarı dolgu arasına panelleri çizebildim şekillerin arasında kırmızı çizgiler var makro için engel olmaz umarım

ben 2 hafta içinde forumda öğrendiklerimle şimdilik sonuca gidiyorum (daha kırmızıların başladığıo bittiği yerlerdeki sayılar ayrı ayrı hesaplara tabii). ama işin başındaki durum böyle bir karelajda kaç sıra panel var ve panellerin her sırada listelenmesi

 

[modoste]

sayın hocam karayolunda var olan toprakarme imalatları ile ilgili bir kendimce birşeyler hazırlıyorum sizlerin destekleriyle. dikkat edilirse her çeşit panel var hepsinin adları farklı alanları farklı hepsinin gerisine monte edilecek teller farklı vs vs.

 

[Korhan Ayhan]

Listeyi nereye yapacağız?

 

[modoste]

yandaki bir sekmeye olabilir hocam
dikkat edilirse ben baştan biraz sütun gizledim gönderdim. kendi çalışmamda bende sarı dolgulu yer arasına çizecem.

 

[Korhan Ayhan]

Kırmızı çizgiler dikkate alınacak mı?

 

[modoste]

hocam ben size kırmızıları iptal ederek yeniden göndericem

 

[modoste]

Kırmızı ile ayrılmış çizgileri (bazen panelin tam ortasından geçtiği için) silmem gerekti)

 

[Korhan Ayhan]

Sonuçları kontrol edersiniz..

 

[modoste]

hocam sonuçlar hatalı çıkıyo ve karışık biçimde yanıtlar çıkıyo

ilk birkaç sıradaki paneller ve sıraları hocam ama sizden gelen makro böyle sonuçlar vermedi yeşil dolgulu sağa giden sayılar sıra,

 

[modoste]

makro sonucu bu karışık liste çıkıyo hocam

 

[Korhan Ayhan]

Dosyayı güncelledim. Deneyiniz.