Makroyla Bir Sayfadan Veri Yazdırma

Katılım
27 Eylül 2023
Mesajlar
44
Excel Vers. ve Dili
Microsoft Office Standart 2016 EN 64 Bit
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
 
Katılım
27 Eylül 2023
Mesajlar
44
Excel Vers. ve Dili
Microsoft Office Standart 2016 EN 64 Bit
Katılım
12 Aralık 2015
Mesajlar
1,207
Excel Vers. ve Dili
Türkçe Ofis 2007
Alternatif, deneyin.
Kod:
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
 
Son düzenleme:
Katılım
27 Eylül 2023
Mesajlar
44
Excel Vers. ve Dili
Microsoft Office Standart 2016 EN 64 Bit
Alternatif, deneyin.
Kod:
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?
 
Son düzenleme:
Katılım
12 Aralık 2015
Mesajlar
1,207
Excel Vers. ve Dili
Türkçe Ofis 2007
#4 mesajda Msgbox da tarihleri gösteren satırlar ekledim. Ancak nereye yapıştırılacağını yazmamışsın.
Kod:
MsgBox Sheet1.Cells(sat, "C")
 
Katılım
27 Eylül 2023
Mesajlar
44
Excel Vers. ve Dili
Microsoft Office Standart 2016 EN 64 Bit
#4 mesajda Msgbox da tarihleri gösteren satırlar ekledim. Ancak nereye yapıştırılacağını yazmamışsın.
Kod:
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
 
Son düzenleme:
Katılım
12 Aralık 2015
Mesajlar
1,207
Excel Vers. ve Dili
Türkçe Ofis 2007
Kod:
Format(Sheet1.Cells(sat, "C"), "dd.mm.yyyy")
kodlardaki yukardaki kısımları aşağıdaki kodla değiştirin. Daha doğru olur.
Kod:
CDate(Sheet1.Cells(sat, "C"))
 
Katılım
27 Eylül 2023
Mesajlar
44
Excel Vers. ve Dili
Microsoft Office Standart 2016 EN 64 Bit
Kod:
Format(Sheet1.Cells(sat, "C"), "dd.mm.yyyy")
kodlardaki yukardaki kısımları aşağıdaki kodla değiştirin. Daha doğru olur.
Kod:
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?
 
Üst