Makroyla Bir Sayfadan Veri Yazdırma

[mrvctug]

https://dosya.co/6obertqcl402/örnekçalışma.xlsx.html
Merhaba,
Sheet1 de b sütununda irsaliye nolar, c sütununda tarihler ve 2. columnda 31 tane part number var. Bu part numberlardan sonrada bişey yazılma durumu olursa diye sadece o kısmı makroda gösterilebilir mi? Yani Sheet1 deki irsaliye no ve tarihe göre part number adetleri Sheet2 deki irsaliye noya göre tarihi gelip part number adetlerinin karşılığı yazılabilir mi? Örnek çalışma excelinde daha iyi anlaşılır demek istediğim. Elimde kod var ama uyarlayamadım. Yardımcı olur musunuz?

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

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

Link:
https://s6.dosya.tc/server16/z2hy4r/mrvctug-ornekcalisma.zip.html

NOT: Veri doğruluğunu mutlaka kontrol edin.

 

[mrvctug]

Merhaba;
Eki deneyin.
İyi çalışmalar.

Link:
https://s6.dosya.tc/server16/z2hy4r/mrvctug-ornekcalisma.zip.html

NOT: Veri doğruluğunu mutlaka kontrol edin.

Merhaba cevap verdiğiniz için teşekkür ederim. Ama Sayfa2 de kenarda sütunda görmek değil benim amacım direk ilgili yerlere part numberların gelmesi gerekli

 

[alicimri]

Alternatif, deneyin.

Sub Makro1()
soncol = Sheet2.Cells(3, Columns.Count).End(1).Column
For i = 4 To soncol
If Sheet2.Cells(3, i) <> "" Then
aranan = Sheet2.Cells(3, i)
sat = Sheet1.Columns(2).Find(aranan).Row
Sheet1.Range("D" & sat & ":W" & sat).Copy
Sheet2.Cells(5, i).PasteSpecial Transpose:=True
 Sheet2.Cells(2, i).Value = CDate(Sheet1.Cells(sat, "C"))
End If
Next

soncol1 = Sheet2.Cells(28, Columns.Count).End(1).Column
For x = 4 To soncol1
If Sheet2.Cells(28, x) <> "" Then
aranan = Sheet2.Cells(28, x)
sat = Sheet1.Columns(2).Find(aranan).Row
aranan = Sheet2.Cells(3, i)
Sheet1.Range("Y" & sat & ":AI" & sat).Copy
Sheet2.Cells(30, x).PasteSpecial Transpose:=True
         Sheet2.Cells(27, x).Value = CDate(Sheet1.Cells(sat, "C"))
End If
Next
Sheet2.Cells(Rows.Count, 1).Value = -1
Sheet2.Cells(Rows.Count, 1).Copy
    Sheet2.Range("D5:I24").SpecialCells(2, 1).PasteSpecial Operation:=4
    Sheet2.Range("D30:I40").SpecialCells(2, 1).PasteSpecial Operation:=4
Sheet2.Cells(Rows.Count, 1).ClearContents
End Sub

 

[mrvctug]

Alternatif, deneyin.

Sub Makro1()
soncol = Sheet2.Cells(3, Columns.Count).End(1).Column
For i = 4 To soncol
If Sheet2.Cells(3, i) <> "" Then
aranan = Sheet2.Cells(3, i)
sat = Sheet1.Columns(2).Find(aranan).Row
Sheet1.Range("D" & sat & ":W" & sat).Copy
Sheet2.Cells(5, i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End If
Next

soncol1 = Sheet2.Cells(28, Columns.Count).End(1).Column
For x = 4 To soncol1
If Sheet2.Cells(28, x) <> "" Then
aranan = Sheet2.Cells(28, x)
sat = Sheet1.Columns(2).Find(aranan).Row
Sheet1.Range("Y" & sat & ":AI" & sat).Copy
Sheet2.Cells(30, x).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End If
Next

End Sub

Merhaba çok teşekkür ederim bir şey daha sormak istiyorum. Değerleri - değilde + ve irsaliye noların üzerinde tarihlerini nasıl getirebilirim?

 

[alicimri]

#4 mesajda Msgbox da tarihleri gösteren satırlar ekledim. Ancak nereye yapıştırılacağını yazmamışsın.

MsgBox Sheet1.Cells(sat, "C")

 

[mrvctug]

#4 mesajda Msgbox da tarihleri gösteren satırlar ekledim. Ancak nereye yapıştırılacağını yazmamışsın.

MsgBox Sheet1.Cells(sat, "C")

sheet2 de irsaliye noların üzerinde tarih diye excel tablosunda belliydi aslında part number adetlerini peki + değerli nasıl gösterebilirim

 

[alicimri]

#4 mesajda kodları yeniledim.

 

[alicimri]

Format(Sheet1.Cells(sat, "C"), "dd.mm.yyyy")

kodlardaki yukardaki kısımları aşağıdaki kodla değiştirin. Daha doğru olur.

CDate(Sheet1.Cells(sat, "C"))

 

[mrvctug]

Format(Sheet1.Cells(sat, "C"), "dd.mm.yyyy")

kodlardaki yukardaki kısımları aşağıdaki kodla değiştirin. Daha doğru olur.

CDate(Sheet1.Cells(sat, "C"))

Teşekkür ederim tarihlerde geldi. Peki part number adetlerini - değer yerine + değer gelmesini nasıl yaparım?

 

[alicimri]

#4 mesajda kodları tekrar yeniledim.

 

[mrvctug]

#4 mesajda kodları tekrar yeniledim.

Çok teşekkür ederim elinize sağlık çok yardımcı oldunuz.