Excel Makro Bir Sayfadaki Veriyi Diğer Sayfadaki Veriye Göre Değerleri Getirtme

[mrvctug]

Merhaba,
Excelde birinci sayfadaki irsaliye nolara göre part numberlar ikinci sayfada irsaliye nolara göre karşılığına yazdırmam gerekli. Birinci sayfada veriler eksi değerli ikinci sayfaya artı değerli gelmesi lazım.
Birde Örnek excel çalışmamda şöyle birşey yapmak mümkün mü?
Sheet1 de 31 tane part number var bu part numberlardan sonrada bişey yazılma durumu olursa diye sadece o kısmı makroda gösterilebilir mi?
Sheet2 de alt kısma da yazan değerler gelebilir mi?
Yardımcı olabilir misiniz?

Public Sub Deneme()

Dim sonCol As Integer
Dim i As Long
Dim col As Integer
Dim arr As Variant
Dim c As Range


sonCol = Sheet1.Cells(2, Columns.Count).End(1).Column

col = 4

Do Until Sheet2.Cells(3, col) = ""

Set c = Sheet1.Range("B:B").Find(Sheet2.Cells(3, col), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
Sheet2.Cells(2, col + 1) = Sheet1.Cells(c.Row, 3) 'Tarihi yazdırdık
arr = Sheet1.Range(Sheet1.Cells(c.Row, 4), Sheet1.Cells(c.Row, sonCol)).Value
For i = LBound(arr, 2) To UBound(arr, 2)
If Not arr(1, i) = "" Then arr(1, i) = Abs(arr(1, i))
Next i
Sheet2.Cells(5, col).Resize(UBound(arr, 2), 1) = Application.WorksheetFunction.Transpose(arr)
End If

col = col + 2
Loop

MsgBox "Listeleme Bitmiştir .....", vbInformation
End Sub

Elimde böyle kod var Forumda sorup dönüş yapılmıştı.
https://s6.dosya.tc/server16/eqkd2d/ornekcalisma.xlsx.html

 

[mrvctug]

Lütfen yardımcı olur musunuz?

 

[mrvctug]

Sorunumu çözemedim lütfen yardım eder misiniz?

 

[DoğanD]

Merhaba,

Anladığım kadarı ile bir fonksiyon yazdım fakat biraz amatörce oldu. Kodu bir modüle yapıştırdıktan sonra Excel'de "=Listele(Part Numarası; İrsaliye Numarası; Tarih)" komutu ile kullanmalısınız. Döngü ile hesaplama yaptığı için işlem bitince Özel Yapıştır > Değerleri yaparak formülden kurtarmakta fayda var.

Function Listele(PartNo As Range, IrsNo As Range, Tarihh As Range)
Dim i, y As Integer
For i = 1 To 36
    For y = 1 To 133
        If Sheet1.Cells(6, i) = PartNo And Sheet1.Cells(y, 2) = IrsNo And Sheet1.Cells(y, 3) = Tarihh Then
        Listele = Listele + (Sheet1.Cells(y, i) * -1)
        End If
    Next y
Next i
End Function

 

[mrvctug]

Merhaba teşekkür ederim öncelikle yanıt verdiğiniz için.
elimdeki bu kod çalışıyor ama sayfa1de ne kadar veri varsa hepsinin irsaliyedeki karşılığı geliyor mesela toplamları filanda geliyor sadece ben irsaliye no ya partnumber değerleri karşılık gelenler sadece gelsin istiyorum yapamadım onu. Linketeki excel incelerseniz anlarsınız aslında.


sonCol = Sheet1.Cells(2, Columns.Count).End(1).Column

col = 4

Do Until Sheet2.Cells(3, col) = ""

Set c = Sheet1.Range("B:B").Find(Sheet2.Cells(3, col), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
Sheet2.Cells(2, col + 1) = Sheet1.Cells(c.Row, 3) 'Tarihi yazdırdık
arr = Sheet1.Range(Sheet1.Cells(c.Row, 4), Sheet1.Cells(c.Row, sonCol)).Value
For i = LBound(arr, 2) To UBound(arr, 2)
If Not arr(1, i) = "" Then arr(1, i) = Abs(arr(1, i))
Next i
Sheet2.Cells(5, col).Resize(UBound(arr, 2), 1) = Application.WorksheetFunction.Transpose(arr)
End If

col = col + 2
Loop

MsgBox "Listeleme Bitmiştir .....", vbInformation
End Sub