- Katılım
- 27 Eylül 2023
- Mesajlar
- 44
- Excel Vers. ve Dili
- Microsoft Office Standart 2016 EN 64 Bit
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
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
Son düzenleme: