[sahika51]

Merhabalar bir stok çalışması yapmaya çalışıyorum bir kaç yerde takıldım. Yardım ederseniz sevinirim.
Aşağıdaki kodu sayfaya1 yükledim eksikleri var.
1- Kod programı D Sütununn en son satırına veri girince değeri direk Stok sayfasının ilgili satırına eklensin.
2. Stoktaki B stünuna veriler eklendikçe Sıra Numarası otomatik verilsin
3. sayfa1 den gelen benzersiz değerlerin karşısındaki G3:G1000 toplamları stok sayfasında C sütununda alınsın. Örnek verecek olursak
Stok B3 M.SODA nın C3 212 olmalı gibi
Sub listele()
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim i As Long, son As Long, son1 As Long, son2 As Long, sat As Long

Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Stok")

Application.ScreenUpdating = False

son = S1.[D65536].End(3).Row

S2.Range("b3:b65536").ClearContents

sat = 2
For i = 3 To son

If WorksheetFunction.CountIf(S1.Range("d3:d" & i), S1.Cells(i, "d")) = 1 Then
sat = sat + 1
S2.Cells(sat, "b") = S1.Cells(i, "d")
End If
Next
End Sub

[sahika51]

Zannedersem bayağı zor bir soru sordum.

[Feyzullah]

Kod: Tümünü seç

Sub listele()
'Metehan8001  // Feyzullah Www.ExcelDestek.Com'
Dim S1 As Worksheet: Set S1 = Sheets("Sayfa1")
Dim S2 As Worksheet: Set S2 = Sheets("Stok")

Application.ScreenUpdating = False
son = S1.Cells(Rows.Count, 4).End(xlUp).Row
S2.Range("b3:b" & S2.Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
sat = 2
For i = 3 To son
    If WorksheetFunction.CountIf(S2.Range("b3:b" & i), S1.Cells(i, "d")) < 1 Then
    sat = sat + 1
    toplam = WorksheetFunction.SumIf(S1.Range("D3:D" & son), S1.Cells(i, 4), S1.Range("G3:G" & son))
    S2.Cells(sat, 1).Resize(1, 3) = Array(sat - 2, S1.Cells(i, "d"), toplam)
    End If
Next
Application.ScreenUpdating = True
MsgBox "...: İşlem Tamam :...", vbInformation + vbMsgBoxRtlReading, "Www.ExcelDestek.Com"
End Sub



[sahika51]

Kod: Tümünü seç

Sub listele()
'Metehan8001  // Feyzullah Www.ExcelDestek.Com'
Dim S1 As Worksheet: Set S1 = Sheets("Sayfa1")
Dim S2 As Worksheet: Set S2 = Sheets("Stok")

Application.ScreenUpdating = False
son = S1.Cells(Rows.Count, 4).End(xlUp).Row
S2.Range("b3:b" & S2.Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
sat = 2
For i = 3 To son
    If WorksheetFunction.CountIf(S2.Range("b3:b" & i), S1.Cells(i, "d")) < 1 Then
    sat = sat + 1
    toplam = WorksheetFunction.SumIf(S1.Range("D3:D" & son), S1.Cells(i, 4), S1.Range("G3:G" & son))
    S2.Cells(sat, 1).Resize(1, 3) = Array(sat - 2, S1.Cells(i, "d"), toplam)
    End If
Next
Application.ScreenUpdating = True
MsgBox "...: İşlem Tamam :...", vbInformation + vbMsgBoxRtlReading, "Www.ExcelDestek.Com"
End Sub



Feyzullah bey kod tam istediğim gibi olmuş teşekkürler. Bu çalışmayı başka bir yerde daha kullanacağım için Ben Bu kodu Sayfa 1 de yapsam ve Stok çalışma sayfasını hiç kullanmadan aynı sıralamayla Sayfa 1 de KLMN sütunlarını kullanmak istiyorum. olabilirmi.

[Feyzullah]

Feyzullah bey kod tam istediğim gibi olmuş teşekkürler. Bu çalışmayı başka bir yerde daha kullanacağım için Ben Bu kodu Sayfa 1 de yapsam ve Stok çalışma sayfasını hiç kullanmadan aynı sıralamayla Sayfa 1 de KLMN sütunlarını kullanmak istiyorum. olabilirmi.

Olabilir, örnek bir dosya eklemenizde yarar var.