Belirli Kolonları XML e aktarma

[ercanborais]

Selamlar Arkadaşlar,

Malum excelde yazılım güncelleme vs olmuyor... Ürün tablomuz var ürün ismi, maliyeti vs bunlar hep aynı... Biz excelde değişiklik yapıyoruz (tasarım, içerik vs) neredeyse her 3 ayda bir.. fakat ürün kodu, ürün ismi ve maliyet vs değişmiyor.... hesaplama alanları değişiyor sadece... Biz buton yapıp XML e aktar dediğimizde ürün kodları,ürün isimleri ve maliyetleri vs XML e aktarsın istiyoruz... Yeni exceli açınca orada da xml den aktar olacak... oraya bastığımızda o xml deki verileri anyı şekilde yapıştıracak...

Ben şehir isim ve plaka olarak yaptım deneme için.

İndir XML Aktarma xlsx

Dosyayı indir XML Aktarma xlsx

dosya.co

En azından bu şekilde her yeni excelde excelden excele kopyala yapıştır yapmamış oluruz...

Şimdiden Allah razı olsun destekleriniz için...

Saygılarımla,

(umarım böyle bişey mümkündür bilmiyorum)

 

[ismailem]

Sub XML_Aktar()

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Urunler")

Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

Dim xmlDoc As Object, root As Object, urun As Object
Set xmlDoc = CreateObject("MSXML2.DOMDocument")

Set root = xmlDoc.createElement("Urunler")
xmlDoc.appendChild root

Dim i As Long
For i = 2 To lastRow
Set urun = xmlDoc.createElement("Urun")

urun.appendChild xmlDoc.createElement("UrunKodu")
urun.LastChild.Text = ws.Cells(i, "A").Value

urun.appendChild xmlDoc.createElement("UrunAdi")
urun.LastChild.Text = ws.Cells(i, "B").Value

urun.appendChild xmlDoc.createElement("Maliyet")
urun.LastChild.Text = ws.Cells(i, "C").Value

root.appendChild urun
Next i

xmlDoc.Save ThisWorkbook.Path & "\Urunler.xml"
MsgBox "XML Aktarımı Tamamlandı", vbInformation

End Sub

Sub XML_Iceri_Aktar()

Dim xmlDoc As Object
Set xmlDoc = CreateObject("MSXML2.DOMDocument")

xmlDoc.Load ThisWorkbook.Path & "\Urunler.xml"

Dim urunler As Object
Set urunler = xmlDoc.SelectNodes("//Urun")

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Urunler")

ws.Range("A2:C" & ws.Rows.Count).ClearContents

Dim i As Long
For i = 0 To urunler.Length - 1
ws.Cells(i + 2, 1).Value = urunler(i).SelectSingleNode("UrunKodu").Text
ws.Cells(i + 2, 2).Value = urunler(i).SelectSingleNode("UrunAdi").Text
ws.Cells(i + 2, 3).Value = urunler(i).SelectSingleNode("Maliyet").Text
Next i

MsgBox "XML'den Aktarım Tamamlandı", vbInformation

End Sub

 

[ercanborais]

Kardeşim Allah senden razı olsun.... Çok teşekkürler...

 

[relaxim]

Merhabalar,

Öğrenmek için soruyorum.
Yeni exceli açınca orada da xml den aktar olacak... oraya bastığımızda o xml deki verileri anyı şekilde yapıştıracak...
Bunu nasıl yapacaksınız anlatabilir misiniz? Benimde listem var başka excel dosyalarında kullanmam lazım...

 

[ismailem]

İndir Personal xlsb

Dosyayı indir Personal xlsb

dosya.co

 

[ismailem]

Personal xlsb dosyasını
%appdata%\Microsoft\Excel\XLSTART
klasörüne ekleyiniz. Windows Ara kutusuna %appdata%\Microsoft\Excel\XLSTART bunu yapıştırınız size klasörü açacaktır. bu dosyayı yapıştırınız.

 

[netzone]

Merhabalar,

Öğrenmek için soruyorum.
Yeni exceli açınca orada da xml den aktar olacak... oraya bastığımızda o xml deki verileri aynı şekilde yapıştıracak...
Bunu nasıl yapacaksınız anlatabilir misiniz? Benimde listem var başka excel dosyalarında kullanmam lazım...

Merhaba,

Verilen koda bakıldığında 2 adet makro olduğu ve bunlardan 1'i dışarı aktarırken diğeri ise içeri aktarırken kullanılacağı görünüyor.
*Yeni açtığınız dosyanıza içeri aktar makrosunu eklemeniz ve dosya ile aynı yere kayıt etmeniz sonucu içeri aktarım başarılı bir şekilde gerçekleşir. Veya arkadaşımızın belirttiği gibi şablon olarak açılış dosyanızı düzenlediğinizde gerçekleşir.

Sayfa Adı: urunler
Xml bu yapıda kayıt edilecektir.

<Urunler>
<Urun>
  <UrunKodu>Ad</UrunKodu>
  <UrunAdi>Alan (km²)[15]</UrunAdi>
  <Maliyet>Nüfus (2021)[16]</Maliyet>
</Urun>
<Urun>
  <UrunKodu>Adana</UrunKodu>
  <UrunAdi>13844</UrunAdi>
  <Maliyet>2263373</Maliyet>
</Urun>
</Urunler>

İçeri aktardığınızda da A,B,C sütunları söz konusu dosyada olduğu gibi kayıt gelecektir.

Ad	Alan (km²)[15]	Nüfus (2021)[16]
Adana	13844​	2263373​

Söz konusu B sütunu atlamasını istiyorsanız paylaşılan kodda UrunAdi ve B sütununa ait olan satırların başına Tek tırnak koyarak açıklama haline getirip kontrol ediniz.

'urun.appendChild xmlDoc.createElement("UrunAdi")
'urun.LastChild.Text = ws.Cells(i, "B").Value

'ws.Cells(i + 2, 2).Value = urunler(i).SelectSingleNode("UrunAdi").Text

İyi çalışmalar.

 

[relaxim]

İlginiz için teşekkürler.
1000 satırlık ürün listesi var. Kodu adı ebatları vb sütunlar var.
Excel olarak sipriş geldiğinde özet tablo ile verileri alıyorum. Tabloda sadece kodlar ve miktarlar var.
Ebadı kullanım miktari gibi bilgileri lazım oluyor düşeyara ile çekiyorum yada ilgili sayfayı kopyala yapıştır yapıyorum.
Oradan düşeyara ile getirtiyorum.
Bu konuyu görünce acaba bir tuşla ilgili verileri yada sayfayı getirtebilir miyim diye düşündüm.
Ürün listesi ve bilgileri olan sayfayı diğer excel kitaplarında lazım olunca kullanmanın kısa yolunu araştırıyorum.
Tabi ürün listesine zaman zaman eklemeler olacak.
Önerilerinizi bekliyorum. Forumdaki herkesin yeni yılını kutlarım.
Saygılar

 

[ismailem]

Sub UrunBilgiGetir()

Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim wb As Workbook, ws As Worksheet
Dim i As Long

Set wb = Workbooks.Open("C:\Veri\Urun_Master.xlsx", ReadOnly:=True)
Set ws = wb.Sheets("Urunler")

For i = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
dict(ws.Cells(i, 1).Value) = Array(ws.Cells(i, 2).Value, ws.Cells(i, 4).Value)
Next i

wb.Close False

With ActiveSheet
For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If dict.exists(.Cells(i, 1).Value) Then
.Cells(i, 3).Value = dict(.Cells(i, 1).Value)(0)
.Cells(i, 4).Value = dict(.Cells(i, 1).Value)(1)
End If
Next i
End With

MsgBox "Ürün bilgileri getirildi"

End Sub