Sütuna göre veri aktarımı ?

[igultekin2000]

iyi günler; çalışmamda takıldığım nokta oldu. Envanter çalışma sayfasının I sütununa göre rapor alıyorum. I sütununda " 0 " ve " İMALAT- " yazan satırları " Mamul_Rapor" sayfasına aktarMAMAK istiyorum. kullandığım makroda nasıl bir düzenleme yapmam gerekiyor.

Sub mamul_rapor_1()
Dim S1 As Worksheet, S2 As Worksheet
Dim a(), b(), Tarih_1 As Date, Tarih_2 As Date
Dim i As Long, Say As Long

Set S1 = Sheets("Envanter")
Set S2 = Sheets("Mamul_Rapor")
Tarih_1 = S2.[C1]: Tarih_2 = S2.[D1]

If Tarih_1 > Tarih_2 Then: MsgBox "Tarihleri kontrol ediniz.", vbCritical: Exit Sub

a = S1.Range("b2:N" & S1.Cells(Rows.Count, 2).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To 7)
For i = 1 To UBound(a)
    If a(i, 8) <> "" And a(i, 8) <> 0 Then
        If Tarih_2 >= a(i, 1) And Tarih_1 <= a(i, 1) Then
            Say = Say + 1
            b(Say, 1) = a(i, 1)
            b(Say, 2) = a(i, 8)
            b(Say, 3) = a(i, 9)
            b(Say, 4) = a(i, 11)
            b(Say, 5) = a(i, 12)
            b(Say, 6) = a(i, 13)
          
        End If
    End If
Next i
S2.Range("B4:H" & Rows.Count).ClearContents
If Say > 0 Then
    S2.[B4].Resize(Say, 7) = b
    S2.[B4].Resize(Say).NumberFormat = "dd.mm.yyyy"
    S2.[E4:H1000].Resize(Say).NumberFormat = "#,##0.00"
    S2.[D4].Resize(Say).NumberFormat = "#,##0"
End If

MsgBox "İşlem Tamam....", vbInformation
End Sub

 

[YUSUF44]

Sanıyorum

If Tarih_2 >= a(i, 1) And Tarih_1 <= a(i, 1) Then


Yerine

If a(i,2) <> "İMALAT-" and a(i,2) <> 0 and Tarih_2 >= a(i, 1) And Tarih_1 <= a(i, 1) Then

Şeklinde olur.

 

[Ziynettin]

H ve I' daki formüller için mamul_rapor_2 kodunu pasif edin ya da silin. H ve I toplamlar için koda satırlar ilave edildi.

Sub mamul_rapor_1()
Dim S1 As Worksheet, S2 As Worksheet
Dim a(), b(), Tarih_1 As Date, Tarih_2 As Date
Dim i As Long, Say As Long

Set S1 = Sheets("Envanter")
Set S2 = Sheets("Mamul_Rapor")
Tarih_1 = S2.[C1]: Tarih_2 = S2.[D1]

If Tarih_1 > Tarih_2 Then: MsgBox "Tarihleri kontrol ediniz.", vbCritical: Exit Sub

a = S1.Range("b2:N" & S1.Cells(Rows.Count, 2).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To 8)
For i = 1 To UBound(a)
    If a(i, 8) <> "" And a(i, 8) <> 0 And Trim(a(i, 8)) <> "İMALAT-" Then
        If Tarih_2 >= a(i, 1) And Tarih_1 <= a(i, 1) Then
            Say = Say + 1
            b(Say, 1) = a(i, 1)
            b(Say, 2) = a(i, 8)
            b(Say, 3) = a(i, 9)
            b(Say, 4) = a(i, 11)
            b(Say, 5) = a(i, 12)
            b(Say, 6) = a(i, 13)
            b(Say, 7) = a(i, 11) + a(i, 13)
            b(Say, 8) = b(Say, 3) * b(Say, 7)
        End If
    End If
Next i
S2.Range("B4:H" & Rows.Count).ClearContents
If Say > 0 Then
    S2.[B4].Resize(Say, 8) = b
    S2.[B4].Resize(Say).NumberFormat = "dd.mm.yyyy"
    S2.[E4:H1000].Resize(Say).NumberFormat = "#,##0.00"
    S2.[D4].Resize(Say).NumberFormat = "#,##0"
End If

MsgBox "İşlem Tamam....", vbInformation
End Sub

 

[igultekin2000]

H ve I' daki formüller için mamul_rapor_2 kodunu pasif edin ya da silin. H ve I toplamlar için koda satırlar ilave edildi.

Sub mamul_rapor_1()
Dim S1 As Worksheet, S2 As Worksheet
Dim a(), b(), Tarih_1 As Date, Tarih_2 As Date
Dim i As Long, Say As Long

Set S1 = Sheets("Envanter")
Set S2 = Sheets("Mamul_Rapor")
Tarih_1 = S2.[C1]: Tarih_2 = S2.[D1]

If Tarih_1 > Tarih_2 Then: MsgBox "Tarihleri kontrol ediniz.", vbCritical: Exit Sub

a = S1.Range("b2:N" & S1.Cells(Rows.Count, 2).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To 8)
For i = 1 To UBound(a)
    If a(i, 8) <> "" And a(i, 8) <> 0 And Trim(a(i, 8)) <> "İMALAT-" Then
        If Tarih_2 >= a(i, 1) And Tarih_1 <= a(i, 1) Then
            Say = Say + 1
            b(Say, 1) = a(i, 1)
            b(Say, 2) = a(i, 8)
            b(Say, 3) = a(i, 9)
            b(Say, 4) = a(i, 11)
            b(Say, 5) = a(i, 12)
            b(Say, 6) = a(i, 13)
            b(Say, 7) = a(i, 11) + a(i, 13)
            b(Say, 8) = b(Say, 3) * b(Say, 7)
        End If
    End If
Next i
S2.Range("B4:H" & Rows.Count).ClearContents
If Say > 0 Then
    S2.[B4].Resize(Say, 8) = b
    S2.[B4].Resize(Say).NumberFormat = "dd.mm.yyyy"
    S2.[E4:H1000].Resize(Say).NumberFormat = "#,##0.00"
    S2.[D4].Resize(Say).NumberFormat = "#,##0"
End If

MsgBox "İşlem Tamam....", vbInformation
End Sub

Teşekkürler, sorun çözüldü, hayırlı çalışmalar.