Excel Makro ile bir sayfadan diğer sayfaya veri yazdırma

[mrvctug]

Merhaba,

Elimdeki excel tablosunda birinci sayfada bulunan sütundaki irsaliye no ve 2. satırda bulunan parça nolarının adetlerine göre verileri ikinci sayfadaki ilgili yerdeki parça no kısmına irsaliye no ya göre yazdıracam. (İrsaliye noya göre parça nolarının adetleri ikinci sayfada ilgili yerlere karşılaştırarak getirilecek)

 

[Necdet]

Merhaba,
Foruma hoş geldiniz.
Örnek dosyanızı paylaşım sitelerinden birine kopyalayıp linkini paylaşırsanız çözüme daha hızlı ulaşma şansınız olur.

 

[mrvctug]

Merhaba,
Örnek çalışma dosyam linkte. Sheet2 kısmında part number sevk adet bölümüne gelmesini istiyorum.( -1, -2 değil 1, 2 diye gelmesi gerekiyor)

https://s6.dosya.tc/server16/ln2uoh/ornekcalisma.xlsx.html

 

[Necdet]

Merhaba,
Tam olarak ne istediniz pek anlamadım ama sayfa2 deki tarihi aratarak bulduğum değerleri yazdırmaya çalıştım.
Eğer doğru anladıysam kodları inceleyiniz.

Public Sub Deneme()

Dim arr As Variant
Dim iNo As Long
Dim i   As Long
Dim j   As Integer
Dim r   As Integer

arr = Sayfa1.Range("b1").CurrentRegion.Value
iNo = Sayfa2.Range("D3")
Sayfa2.Range("A5:E" & Rows.Count).ClearContents

i = 4

Do
    i = i + 1
Loop Until i > UBound(arr, 1) Or arr(i, 1) = iNo

If i <= UBound(arr, 1) Then
    Sayfa2.Range("E2") = arr(i, 2)
    r = 4
    For j = 3 To UBound(arr, 2)
        If Not arr(i, j) = "" Then
            r = r + 1
            Sayfa2.Cells(r, 1) = arr(2, j)
            Sayfa2.Cells(r, 4) = arr(i, j)
        End If
    Next j

End If

End Sub

Ben kodlarda kullandığım Sayfa1, Sayfa2'ler aslında sayfa indisleri. Sizin gördüğünüz Sheet1, Sheet2 değil.

 

[mrvctug]

Merhaba,
öncelikle yanıtladığınız için teşekkür ederim tarihe göre değil irsaliye noya göre buldurma yapmam gerekiyor. Bu haliyle excele macro içerisine atıyorum ama çalıştıramadım.

 

[Necdet]

Merhaba,

Kodları yeniledim oradan alabilirsiniz.

Ben kodları sizin örnek dosyanıza göre yazdım.
Örnek dosyanız ile asıl dosya aranızda fark varsa ona bir şey diyemem.

 

[mrvctug]

Merhaba size attığım excel içerisinde denedim tekrar deniyorum

 

[mrvctug]

https://s6.dosya.tc/server16/2a5y55/verinin_gelecegi_yer.PNG.html
verinin geleceği kısım sheet2deki yer sayfa1 ve sayfa2 diye yazdığınız yerleri ben sayfa adlarıma göre düzenledim. ama boş geliyor
benim istediğim birinci sayfadaki irsaliye noya göre giden parça adetleri ikinci sayfada yukarıda yazan irsaliye noya a sütunundaki part numbera göre adetlerin gelmesi

 

[Necdet]

Kodu yeniledim. İşin aslını bilmeyince, sizde tam olarak açıklamayınca böyle boşuna ve gereksiz yazışmalar artıyor.

 

[mrvctug]

teşekkür ederim elinize sağlık Necdet Bey

 

[mrvctug]

Merhaba,
arr variant olarak tanımlamıştınız. Irs Number kısmına (ASD123456, 123456) hem sayı, hemde harf ve sayı olsa kodda
Loop Until i > UBound(arr, 1) Or arr(i, 1) = iNo
kısmında "subscript out of range error 9 " hatası alıyorum. Nasıl değiştirmem gerekiyor.

 

[Necdet]

Merhaba,
Variant değişkeni hepsini içerir, sıkıntı yok.

Ben array ile değil doğrudan sayfa üzerinde işlem yapan kodları önereyim size.
array ile bir sıkıntı olduğunda gerçek veriyi bilmeyince çözümü anlamak zor olur.
Aşağıdaki kodları deneyiniz.

Kodlardaki yine Sayfa1 dediğimde Sheets("Sheet1") anlaşılmalıdır.

Public Sub Aktar()

Dim i   As Long, _
    col As Integer, _
    k   As Integer, _
    j   As Long, _
    c   As Range
    
i = Sayfa2.Cells(Rows.Count, "A").End(3).Row

If i < 5 Then i = 5

Sayfa2.Range("A5:E" & i).ClearContents
col = Sayfa1.Cells(2, Columns.Count).End(1).Column

Set c = Sayfa1.Range("B:B").Find(Sayfa2.Range("D3"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
    Sayfa2.Range("E2") = Sayfa1.Range("C" & c.Row)
    j = 5
    For k = 4 To col
        If Sayfa1.Cells(c.Row, k) <> "" Then
            Sayfa2.Cells(j, "A") = Sayfa1.Cells(2, k)
            Sayfa2.Cells(j, "D") = Sayfa1.Cells(c.Row, k)
            j = j + 1
        End If
    Next k
Else
    MsgBox "Aranan " & Sayfa2.Range("D3") & " irsaliye No BULUNAMADI...."
End If

End Sub

 

[mrvctug]

col = Sayfa1.Cells(2, Columns.Count).End(1).Column
Sayfa1 de 2. columnun hepsini getiriyor burda şöyle olması mümkün mü Sayfa2 deki A sütununda part numberlar zaten var onlar değişmeden direk karşılığında çıkan adet varsa gelebilir mi?

 

[Necdet]

sayfa2 deki yani (Sheets("Sheet2")) deki A sütunundaki part numberler değişken değil mi? Gördüğüm İrsaliye numarasına göre part numbarların hepsi dolu değil ki.

 

[mrvctug]

Soruyu şöyle düzelteyim sayfa1 de bulunan part numberlar sayfada2 deki a sütununda hepsi olsa ama sadece irsaliye nosuna göre giden part number adetleri gözükse diğer part numberlar boş olarak kalsa

 

[Necdet]

bunu kodda zaten yapabilirsiniz.

    For k = 4 To col
        If Sayfa1.Cells(c.Row, k) <> "" Then
            Sayfa2.Cells(j, "A") = Sayfa1.Cells(2, k)
            Sayfa2.Cells(j, "D") = Sayfa1.Cells(c.Row, k)
            j = j + 1
        End If
    Next k

Yukarıda verdiği kod bölümünde if ve A sütununa yazan 2 satırı çıkartın sizin dediğinizi yapar.

 

[mrvctug]

Merhaba sayfa2 de d3 hücresinde irs no yazıyor. f3, h3, j3 vs. hücrelerde de başka irs no yazsa onları nasıl for döngüsüyle gösterebilirim. Birde gelen adet parçaları - değerde değil de + değerde gelebilir mi?

 

[Necdet]

Merhaba,

İstemek kolay da, sayfa2 de D sütununda gösteriliyor part number dediğiniz şeyer.
Çoklu irsaliye olunca bunlar nasıl gösterilecek? Bir fikriniz var mı?

 

[mrvctug]

https://s6.dosya.tc/server16/i04ujw/ornekcalisma.xlsx.html
Sheet2de nasıl demek istediğimi gösterdim. Denedim ama for ile oluşturamadım. Size sormak istedim.

 

[Necdet]

Merhaba,
Parça Numaraları 20 ye düşmüş, daha önce 31 idi.
Az ya da çok olabilir mi?

Birazdan hastane işlerim var, çıkmak zorundayım, ne zaman gelirsem bakacam.
Bu arada bir arkadaş da yardımcı olabilir tabi