Rapor sayfasına yeni ürün eklemek istiyorum?...

[Emine Şahin]

Merhaba arkadaşlar. Sürekli kullandığım bir hesap cetvelim var.
Ekteki "orijinal" adlı dosyada 2, 12, 24 ve 45 adlı ürünleri veri sayfasından girip rapor sayfasına
"rapor çıkar" butonu ile rapor alıyordum.
Ancak bu ürünlere yeni bir ürün daha eklemem gerekti. Ekteki "rapor" adlı dosyada ise "rapor sayfasına "su" adlı bir ürün daha girdim. Ancak visul diliyle yazılmış kodları çözümleyemedim.
Yardımcı olabilir misiniz?

 

[Emine Şahin]

Modül 1'deki kodlar aşağıdaki gibidir...

c = 1
Application.ScreenUpdating = False
For a = 2 To [a65536].End(xlUp).Row
If WorksheetFunction.CountIf(Range("A2:A" & a), Cells(a, 1)) = 1 Then
c = c + 1
Sheets("RAPOR").Cells(c + 1, "A") = Cells(a, "A")
End If
Next
For i = 2 To Cells(65536, "A").End(xlUp).Row
Set k = Sheets("RAPOR").Range("A3:A65536").Find(Range("A" & i).Value, , , xlWhole)
If Not k Is Nothing Then
For j = 2 To 5
If Range("B" & i).Value = Sheets("RAPOR").Cells(2, j).Value Then
Sheets("RAPOR").Cells(k.Row, j).Value = Cells(i, "C").Value + Sheets("RAPOR").Cells(k.Row, j).Value
End If
Next j
For t = 6 To 9
If Range("B" & i).Value = Sheets("RAPOR").Cells(2, t).Value Then
Sheets("RAPOR").Cells(k.Row, t).Value = Cells(i, "D").Value
End If
Next t
For s = 10 To 13
Sheets("RAPOR").Cells(k.Row, s).Value = Sheets("RAPOR").Cells(k.Row, s - 4).Value _
* Sheets("RAPOR").Cells(k.Row, s - 8).Value
Next s
adrs = Range(Cells(k.Row, "J"), Cells(k.Row, "M")).Address
Sheets("RAPOR").Range("N" & k.Row).Formula = "=sum(" & adrs & ")"
End If
Next i
Application.ScreenUpdating = True
Sheets("RAPOR").Select
MsgBox "R A P O R Ç I K A R I L D I ..!!", vbOKOnly, Application.UserName
End Sub

 

[Mehmet Şahin]

Şu şekilde denermisiniz, saygılar.

Sub Rapor()
Dim c As Long, i As Long, j As Byte, t As Byte, s As Byte
Sheets("veri girişi").Select
Sheets("RAPOR").Range("A3:Q65536").ClearContents
c = 1
Application.ScreenUpdating = False
For a = 2 To [a65536].End(xlUp).Row
If WorksheetFunction.CountIf(Range("A2:A" & a), Cells(a, 1)) = 1 Then
c = c + 1
Sheets("RAPOR").Cells(c + 1, "A") = Cells(a, "A")
End If
Next
For i = 2 To Cells(65536, "A").End(xlUp).Row
    Set k = Sheets("RAPOR").Range("A3:A65536").Find(Range("A" & i).Value, , , xlWhole)
    If Not k Is Nothing Then
        For j = 2 To 6
            If Range("B" & i).Value = Sheets("RAPOR").Cells(2, j).Value Then
                Sheets("RAPOR").Cells(k.Row, j).Value = Cells(i, "C").Value + Sheets("RAPOR").Cells(k.Row, j).Value
            End If
        Next j
        For t = 7 To 11
            If Range("B" & i).Value = Sheets("RAPOR").Cells(2, t).Value Then
                Sheets("RAPOR").Cells(k.Row, t).Value = Cells(i, "D").Value
            End If
        Next t
        For s = 12 To 16
            Sheets("RAPOR").Cells(k.Row, s).Value = Sheets("RAPOR").Cells(k.Row, s - 5).Value _
            * Sheets("RAPOR").Cells(k.Row, s - 10).Value
        Next s
        adrs = Range(Cells(k.Row, "L"), Cells(k.Row, "P")).Address
        Sheets("RAPOR").Range("Q" & k.Row).Formula = "=sum(" & adrs & ")"
    End If
Next i
Application.ScreenUpdating = True
Sheets("RAPOR").Select
MsgBox "R A P O R    Ç I K A R I L D I  ..!!", vbOKOnly, Application.UserName
End Sub

 

[Emine Şahin]

Evet, süper oldu...
Allah razı olsun. Ben taplodan isimleri değiştirdiğimde istediğim sonucu veriyordu.
Yani 45 yerine su yazdığımda su ile ilgili verileri hesaplıyordu. Sadece yeni sütun açtığımda
Çalışmıyordu. Ben eski kodlarla yenilerini bir inceleyeyim. belki bir şey öğrenebilirim.

Telrar teşekkür ederim. Emeğinize bilginize sağlık.