Dizeden farklı olanları almak

Katılım
17 Haziran 2008
Mesajlar
1,859
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
@Haluk;

C# Yapamadım bir türlü.., regex den yapayım dedim başka sorunlarla karşılaştım... şu an için beklemede...

Teşekkür ederim.
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,323
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
RegEx ile ne yapmaya çalıştığınızı bilmiyorum...... Verdiğiniz örnekteki gibi Çap, Adet ve Boy değerlerini 3 adet diziye almamışmıydınız?

Dwg dosyasından bu verileri "Ø8/12 L=255" gibi metinsel bir ifadeden ayıklamaya mı çalışıyorsunuz?

.
 
Katılım
17 Haziran 2008
Mesajlar
1,859
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
Evet . aldım. onlarda zaten Regex ile alınmış verilerdi. sonra bir döngü daha oluşturdum çapa göre, bu sefer değişkeni regex içinde tanımlayamadım. amacım, çap sayısı(çeşidi) kadar döngüye tabi tutmaktı.

mesela 4 farklı çap var. döngü her seferinde øx buradaki x değeri yerine çapı yerleştirip hesap yapmaktı amacım.
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,323
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Yani, elinizde 3 adet dizi yok henüz..... öyle mi?

.
 
Katılım
17 Haziran 2008
Mesajlar
1,859
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
dizi var hocam. ben sonrasını anlatıyorum...
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,323
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Diziler varsa, ayıklanmasını gösteren VBA kodlarını mı uyarlayamadınız yani?

@mersilen 'in 7 ve 10 No'lu mesajlarında sanki çapların ayıklanmasına dair kodlar var gibi....

.
 
Katılım
17 Haziran 2008
Mesajlar
1,859
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
Evet hocam. orada sadece çapları ayıklayabildim. Ama oda bi işime yaramadı.
 
Katılım
17 Haziran 2008
Mesajlar
1,859
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
listbox dan örnek vereyim o zaman ;

1 62ø10/15 L=250
2 112ø8/10 L=210
3 25ø14/10 L=240
4 25ø8/9 L=230
5 5ø10/15 L=220
6 25ø10/15 L=220
7 5ø12/15 L=210
8 51ø12/15 L=230
...

şeklinde verilerimiz mevcut..

istenen sonuç :

mesaj kutusu olarak yani ;

ø8 = 292,7 m
ø10 = 221 m
ø12 = 127,80 m
ø14 = 60 m
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,323
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Çapları ayıkladıktan sonra VBA kodlarındaki gibi içiçe 2 adet For döngüsüyle işi bitirebilmeniz lazım .....

Neyse....

.
 
Katılım
17 Haziran 2008
Mesajlar
1,859
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,323
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Userform üzerinde bulunan ListBox nesnesindeki verilerin "RegEx" ile ayrıştırılarak metrajın yapılmasına ilişkin görsel, kodlar ve dosya aşağıdadır.






C#:
Private Sub CommandButton1_Click()
'   Haluk 23/02/2022
    Dim objRegEx As Object, RS As Object, uniqueCaps As New Collection
    Dim i As Integer, j As Integer, mySum As Double
    Dim capDizi(), adetDizi(), lboyDizi()
 
    Const adDouble = 5
 
    iCount = ListBox1.ListCount

    Set objRegEx = CreateObject("VBscript.RegExp")
 
    objRegEx.Pattern = "(\d+)"
    objRegEx.Global = True
 
    For i = 0 To iCount - 1
        myStr = ListBox1.List(i)
        If objRegEx.Test(myStr) Then
            ReDim Preserve capDizi(0 To i)
            ReDim Preserve adetDizi(0 To i)
            ReDim Preserve lboyDizi(0 To i)
         
            adetDizi(i) = objRegEx.Execute(myStr)(0)
            capDizi(i) = objRegEx.Execute(myStr)(1)
            lboyDizi(i) = objRegEx.Execute(myStr)(3)
        End If
    Next
 
    For i = 0 To UBound(capDizi)
        xMatch = CStr(capDizi(i))
        On Error Resume Next
            uniqueCaps.Add xMatch, xMatch
        On Error GoTo 0
    Next

    Set RS = CreateObject("ADODB.Recordset")
    RS.Fields.Append "Cap", adDouble
    RS.Fields.Append "Adet", adDouble
    RS.Fields.Append "Boy", adDouble
    RS.Open

    For i = LBound(capDizi) To UBound(capDizi)
        RS.AddNew
        RS.Fields("Cap").Value = capDizi(i)
        RS.Fields("Adet").Value = adetDizi(i)
        RS.Fields("Boy").Value = lboyDizi(i)
    Next

    RS("Cap").Properties("Optimize") = True

    RS.Update
    RS.MoveFirst
 
    For i = 1 To uniqueCaps.Count
        mySum = 0
        RS.Filter = "Cap = " & uniqueCaps.Item(i)
   
        For j = 0 To RS.RecordCount - 1
            mySum = mySum + RS.Fields("Adet") * RS.Fields("Boy")
            RS.MoveNext
        Next
   
        temp = temp & "Ø" & uniqueCaps.Item(i) & vbTab & " : " & mySum / 100 & " metre" & vbCrLf
    Next

    MsgBox "Metraj sonuçları: " & vbCrLf & vbCrLf & temp

    RS.Close
    Set RS = Nothing
End Sub


.
 
Son düzenleme:
Katılım
17 Haziran 2008
Mesajlar
1,859
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
@Haluk;

Emeğiniz için Çok teşekkürler ağabey.., Artık kodları uyarlamak bana kalıyor..
 
Katılım
17 Haziran 2008
Mesajlar
1,859
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
Hele şükür... yaptım.

 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,323
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Güzel.... geçmiş olsun.

.
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,323
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Bu arada gözünüzden kaçmasın, demirleri metretül ağırlıklarıyla çarpmayı unutmayın...

.
 
Katılım
17 Haziran 2008
Mesajlar
1,859
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
Evet Hocam. Aynen öyle.

* Çok güzel oldu desem, Tam yeridir. :)

 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,323
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Bence de ... :)

.
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,323
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Bu arada, eğer yukarıda önerdiğim Recordset nesnesini kullanıyorsanız, koddaki "Filter" komutu ile filtreleme yapabilirsiniz.

Aşağıdaki resimde, örnek olarak Ø12 ve Ø14 demirler "MsgBox" ile gösterilmektedir. Hakedişlerde ince demir, kalın demir ayrımı yaparken bu özelliği kullanarak Ø8 ~ Ø12 ile Ø14 ~ Ø32 ayrımı yapılmasında gerekli olabilir belki...

Not: Userform'un sağ tarafındaki ListBox2 nesnesindeki "Kg/Mt" ve "Metraj" sütunları Recordset nesnesi hazırlanırken hesaplanmakta ve "Çap", "Adet", "Boy" alanlarıyla birlikte komple Recordset nesnesinden alınmaktadır. .




.
 
Son düzenleme:

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,323
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Eğer "Recordset" nesnesini bilgisayarda fiziki olarak bir dosya olarak kaydetmek isterseniz, XML dosyası olarak kaydedilebilir ve daha sonra ihtiyaç duyulması halinde bu dosyadan veriler okunabilir.





.
 
Üst