xml belgesi içerisinden değer değiştirmek

[cebelitarık]

Forumun değerli üyeleri
Ekte bulunan örnek dosya içerindeki
Aktar makrosu ile xml belgesi içerinden birinci satırı "C" stununa alıyoruz.

Xml belgesi içerisinden "C" sütununda bulduğumuz degeri karşılık gelen "G" sütunundaki değer ile değiştirmek istiyorum.
Saygılarımla

 

[cebelitarık]

Xml belgesi diye korkmayalım netice de bir nevi text belgesi.
Genelde soru ve cevap konuları bir birinin benzeri konular.
Böyle arada bir extrem konu sorulduğu zaman çok geç cevap veriliyor.
Ben biliyorumki bu konuyu çok iyi bilen çok değerli arkadaşlarımız vardır.
Forumun çok değerli ve bilgili arkadaşlarından cevap bekliyorum.
Saygılarımla

 

[siyahoglu]

Listede nokta ile ayrılmış sayıları toplama yapamıyorum.
Nasıl yapabilirim.
Altan

200.00 224.00
80.25 89.88
92.38 103.47
-91.88 -102.90
238.00 266.56
191.00 213.92

0,00

 

[Zeki Gürsoy]

Sub ilk_satiri_al()
    Dim P As String, data As String
    
    P = ThisWorkbook.Path & "\ogrenciler.xml"
    
    Open P For Input As #1
        Line Input #1, data
        [c2] = data
    Close #1
End Sub

Sub ilk_satiri_degistir()
    Dim P As String, data As String, arr() As String, i As Long

    P = ThisWorkbook.Path & "\ogrenciler.xml"
    
    Open P For Input As #1
        Do Until EOF(1)
            i = i + 1
            Line Input #1, data
            ReDim Preserve arr(1 To i)
            arr(i) = data
        Loop
    Close #1
    
    arr(1) = [g2]
    
    Open P For Output As #1
        For i = 1 To UBound(arr)
            Print #1, arr(i)
        Next
    Close #1
End Sub

 

[cebelitarık]

Sayın Zeki Gürsoy
İlgin için teşekkür ederim.
Verdiğiniz kodun 2. bölümünde "Loop without Do" hata sı verdi.
Bu hatayı kolayca düzelteceğinizi umuyorum.
Ancak benim vermiş olduğum örnek dosyada öncelikle klasör seçiyordum ve o klasör içinde bulunan tüm xml belgelerinin ilk satırları değiştirmek istiyordum. Şu an için klasör içerisinde bir doya var ama bizim istediğimiz daha fazla dosya ilk satırını değiştirmek istiyorum.
Benim kodların devamına bir şeyler yapmak mümkünmü acaba?

Saygılarımla

 

[Zeki Gürsoy]

Alt klasörler de dahil mi?

 

[cebelitarık]

Sayın Zeki Gürsoy
Alt klasörler değilde sadece bu klasör içinde bulunan dosyaların ilk satırları G2 hücresinden itibaren aşağı doğru karşılık gelen değerler ile değişecek değişecek.
Yeni örnek dosya ekledim içeriğinde biraz daha ayrıntılı açıklama yaptım.
Eğer benim başlatmış olduğum kodlar devamına ve "Değiş" butonu altına yazabilirsek çok daha iyi olacak sanırım. Ancak proje daha işlevsel olsun diye "Aktar" makrosu ile istediğim klasörü seçmek daha kullanışlı.
Not: önceki kodun loop hatasına da bir çözüm üretirseniz kod hatalı kalmasın başka arkadaşlarda koddan faydalanabilir.
Saygılarımla

 

[Zeki Gürsoy]

Deneyin...

Private a As String

Sub main1()
    Dim y As Object, d As String
    'ilk satırları sayfaya alma...
    Set y = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör seç", 0)
    If y Is Nothing Then Exit Sub
    a = IIf(Right(y.Self.Path, 1) = "\", y.Self.Path, y.Self.Path & "\")
    
    d = Dir(a & "*.xml")
    While d <> ""
        s = s + 1
        Cells(s + 1, "a") = d
        Cells(s + 1, "c") = ilk_satiri_al(a & "\" & d)
        d = Dir
    Wend
End Sub

Sub main2()
    Dim z As Integer
    '"g" sütun değerlerini dosyalara aktarma...
    If MsgBox("Geçerli dizin : " & a & " olarak görünüyor." & _
        Chr(13) & "Değiştirmek istiyor musunuz?", vbYesNo) = vbYes Then
        Set y = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör seç", 0)
        If y Is Nothing Then Exit Sub
        a = IIf(Right(y.Self.Path, 1) = "\", y.Self.Path, y.Self.Path & "\")
    End If
    
    For z = 2 To [a65536].End(3).Row
        Call ilk_satiri_degistir(a & Cells(z, "a"), z)
    Next
End Sub
Private Function ilk_satiri_al(ByRef P As String) As String
    Dim data As String
   
    Open P For Input As #1
        Line Input #1, data
        ilk_satiri_al = data
    Close #1
End Function

Private Sub ilk_satiri_degistir(ByRef P As String, ByRef r As Integer)
    Dim data As String, arr() As String, i As Long
    
    Open P For Input As #1
        Do Until EOF(1)
            i = i + 1
            Line Input #1, data
            ReDim Preserve arr(1 To i)
            arr(i) = data
      Loop
    Close #1
    
    arr(1) = Cells(r, "g")
    
    Open P For Output As #1
        For i = 1 To UBound(arr)
            Print #1, arr(i)
        Next
    Close #1
End Sub

 

[cebelitarık]

Sayın zeki Gürsoy Teşekkür ederim

Private Sub ilk_satiri_degistir(ByRef P As String, ByRef r As Integer)
    Dim data As String, arr() As String, i As Long
    
  [COLOR="Red"]Open P For Input As #1[/COLOR]
        Do Until EOF(1)
            i = i + 1
            Line Input #1, data
            ReDim Preserve arr(1 To i)
            arr(i) = data
      Loop
    Close #1
    
    arr(1) = Cells(r, "g")
    
    Open P For Output As #1
        For i = 1 To UBound(arr)
            Print #1, arr(i)
        Next
    Close #1
End Sub

Satır alırken yolu gösterelim fakat değişiklik yapacağı zaman aynı önce gösterdiğimiz klasör yolunu kullanabilirmiyiz.
Bu arada
Kırmızı satırda hata verdi file not found hatası verdi dosya yerini gösterdim.
Değişiklik yapacağı zaman dosya yolunu kendi bulsa verileri alırken kullandığımız yolu kullansa olabilirmi
saygıyla

 

[Zeki Gürsoy]

Önceki yolu "a" değişkeninde tutuyor.

Hata için şunu yapıştırın.

Sub main2()
    Dim z As Integer
    '"g" sütun değerlerini dosyalara aktarma...
    If MsgBox("Geçerli dizin : " & a & " olarak görünüyor." & _
        Chr(13) & "Değiştirmek istiyor musunuz?", vbYesNo) = vbYes Then
        Set y = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör seç", 0)
        If y Is Nothing Then Exit Sub
        a = IIf(Right(y.Self.Path, 1) = "\", y.Self.Path, y.Self.Path & "\")
    End If
    
    For z = 2 To [a65536].End(3).Row
        Call ilk_satiri_degistir([COLOR=Blue][B]a &[/B][/COLOR] Cells(z, "a"), z)
    Next
End Sub

 

[cebelitarık]

Sayın Zeki Gürsoy
Çok teşekkür ederim.
Kod çok güzel çalıştı.
Dosya yolunu B stununa yazdırıp ordan tekrar aldım. 2. kere yol gösterme derdi kalmadı.
Bu yol sub lar arasında transfer edilebilirmiydi acaba sayfa içine yazılmadan.
Saygıyla