Çok Değişkenli Verileri Kriterlere Göre Aktarma

Ömer BARAN · 29 Ekim 2015

Bir önceki gönderdiğim dosyada hatalar olduğundan sildim.
Bu cevap ekindeki belgeyi test ediniz.

y.selim · 29 Ekim 2015

Selam Hocam
Son dosya gayet başarılı
Sadece düzenlenecek iki husus kalmış

1) Kol adetlerini atmıyor.

2) Eğer ki T sütununda 1,5 K yada ÇİFT K ibareleri geçiyorsa sadece o satıra ait menteşe adetini iki ile çarpıp o şekilde toplama ilave edecek. (diğer aksesuarlarda değil sadece menteşe için geçerli bir ayrıntı)

Ömer BARAN · 29 Ekim 2015

Son cevaptaki belgeyi yeniledim.
Tekrar indirerek kontrol edin.

Bu arada kol kodlarından bir tanesi T adlı sayfada yokmuş onu ekleyince sorun kalmadı.

Eğer olmayan bir kod varsa; SAYIM işlemi sonucunda

UYARI ekranı görünecektir. Örneğin bir kol kod'unu değiştirerek deneyiniz.

Ömer BARAN · 30 Ekim 2015

Tekrar merhaba.

Mevcut kodları biraz değiştirdim.
-- S adlı sayfada süre yazılmıyor,
-- S adlı sayfadaki koşullu biçimlendirme; sipariş numarasının değiştiğini vurgulamak üzere ayarlandı.
-- Süre olarak bu dosyadaki kod'un biraz daha hızlı olması lazım.
-- U sayfasındaki ilgili sütunlarda (boş olma durumu hariç) T sayfasındaki ilgili sütunlardaki kod sütunlarında omayan hücreler için koşullu biçimlendirme uygulandı (bunu ekleme nedenim, T adlı sayfayı güncellemeniz gerektiğinin anlaşılması). SİL düğmesi kullanılarak U sayfasına dönüldüğünde bu biçimler silinir, İŞLEM düğmesi kullanıldığında tekrar uygulanır. (ikinci belge)

Ekli belgeyi test ediniz.
.

y.selim · 30 Ekim 2015

Merhaba
Birinci dosyayı denedim daha da hızlanmış teşekkürler.Hızınıza yetişilmiyor doğrusu

İkinci dosya da, koşullu olan : "Run-time error '5':" hatasını veriyor deneyemedim.

Birinci dosya da koşullu çizgiler sıra numarasıyla birebir uyumlu değil.

13.000 satırda denediğimde "Run-time error '1004': WorksheetFunction sınıfının Match özelliği alınamıyor" diye bir hata verdi.Ne anlama geldiğini bilmiyorum.

Son olarak S15-27 / S15-69 / S15-232 gibi kodlara bir göz atın aynı ürün kodunu iki kere yazıyor.(Bazıları sürme olduğu için sanırım).Mesela S15-27 de M 900 ün tek yazılması lazım iki kere yazmış.

Ömer BARAN · 30 Ekim 2015

T sütununda SÜRME olduğunda ne yapılacak peki?

Aşağıdaki hususu da göz önüne alarak cevap yazınız.

Kilit, menteşe ve kol dışında satır oluşumu mekanizması;
her satırda, G, O, R, S ve T sütunundaki veriler birleştirilip tek bir bilgi haline getiriliyor,
ardından daha önce aynı bilgi var mıydı? sorusunun cevabı EVET ise
(daha önce o satır için S sayfasına satır eklenmiş demektir)
o satır için S sayfasında yeni satır oluşturulmayıp, bir sonraki satıra geçiyor,
cevap HAYIR ise yani ilk kez karşılaşıldı ise o satırdaki veriler üzerinden YENİ SATIR oluşturuluyor.

y.selim · 31 Ekim 2015

omer.baran' Alıntı:
her satırda, G, O, R, S ve T sütunundaki veriler birleştirilip tek bir bilgi haline getiriliyor

Satırda ki benzersiz ürün kodu değerini oluşturmak için bu uygulama yapılıyor sanırım bu birleştirmeden T yi çıkartsak sadece G, O, R, S birleşse nasıl olur?

Ömer BARAN · 31 Ekim 2015

Belge ekte.

Ömer BARAN · 31 Ekim 2015

Son eklediğim belgede,

BARAN2 adlı moduldeki kod'u aşağıdaki ile değiştirerek dener misiniz?

Koşullu biçimlendirmeyi de gönderdiğim belge üzerinden kontrol ederek
(koşullu biçimlendirme isteğini, her iki sayfa için de 1 rakamını yazarak belirtin)
konu sayfasına yanlış biçimlendirme olan sipariş numarasını yazarsınız.

Kod:

[B][COLOR="Red"]Sub SAYIM()[/COLOR][/B]
Dim U As Worksheet: Set U = Sheets("UV")
Dim T As Worksheet: Set T = Sheets("T")
Dim S As Worksheet: Set S = Sheets("S")
Dim G As Worksheet: Set G = Sheets("GİRİŞ")
Dim K As Worksheet: Set K = Sheets("KODKONTROL")

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
süre = Timer

aalan = "A1:A" & T.[A65536].End(3).Row
dalan = "D1:D" & T.[E65536].End(3).Row
galan = "G1:G" & T.[H65536].End(3).Row
malan = "M1:M" & T.[M65536].End(3).Row
palan = "P1:P" & T.[P65536].End(3).Row
salan = "S1:S" & T.[S65536].End(3).Row
valan = "V1:V" & T.[V65536].End(3).Row
yalan = "Y1:Y" & T.[Y65536].End(3).Row
abalan = "AB1:AB" & T.[AB65536].End(3).Row


Call TEMİZLE
    S.Columns("C:N").FormatConditions.Delete
    U.Columns("E:AN").FormatConditions.Delete

U.Range("AO1") = "ADET"
    With U.Range("AO2:AO" & U.[G65536].End(3).Row)
        .Formula = "=IF(OR(T2=""1,5 K"",T2=""ÇİFT K""),AG2*2,AG2)"
        .Value = .Value
    End With

For sip = 2 To G.[A65536].End(3).Row
            U.Cells(1, 42) = G.Cells(sip, 2): U.Cells(1, 43) = G.Cells(sip, 3)
    For sütun = 53 To 56
        For sat = U.Cells(1, 42) To U.Cells(1, 43)
                If sütun = 53 Then
                    U.Cells(sat, 57) = U.Cells(sat, 7) & " | " & U.Cells(sat, 15) & _
                    " | " & U.Cells(sat, 18) & " | " & U.Cells(sat, 19)
                ElseIf sütun = 54 Then
                            If U.Cells(sat, 34) <> "HARİÇ" Then
                                U.Cells(sat, 57) = U.Cells(sat, 7) & " | " & U.Cells(sat, 34)
                            Else
                                U.Cells(sat, 57) = ""
                            End If
                ElseIf sütun = 55 Then
                            If U.Cells(sat, 36) <> "HARİÇ" Then
                                U.Cells(sat, 57) = U.Cells(sat, 7) & " | " & "" & U.Cells(sat, 36)
                            Else
                                U.Cells(sat, 57) = ""
                            End If
                ElseIf sütun = 56 Then
                            If U.Cells(sat, 38) <> "HARİÇ" Then
                                U.Cells(sat, 57) = U.Cells(sat, 7) & " | " & "" & U.Cells(sat, 38)
                            Else
                                U.Cells(sat, 57) = ""
                            End If
            End If
        Next
                For adeta = U.Cells(1, 42) To U.Cells(1, 43)
                alan2 = "BE" & U.Cells(1, 42) & ":BE" & U.Cells(1, 43)
                    If sütun = 5[B][COLOR="Red"][SIZE="4"]5[/SIZE][/COLOR][/B] Then
                alan3 = "AO" & U.Cells(1, 42) & ":AO" & U.Cells(1, 43)
                    Else
                alan3 = "AG" & U.Cells(1, 42) & ":AG" & U.Cells(1, 43)
                    End If
[B][COLOR="Blue"]55[/COLOR][/B]
                    If WorksheetFunction.CountIf(U.Range("BE" & U.Cells(1, 42) & ":BE" & adeta), U.Cells(adeta, 57)) = 1 Then
                        S.Cells(S.[L65536].End(3).Row + 1, 12) = WorksheetFunction.SumIf(U.Range(alan2), _
                                                                "" & U.Cells(adeta, 57), U.Range(alan3))
                    
                    
On Error Resume Next
If sütun = 53 Then
If U.Cells(adeta, 20) = "KASA" Then
    kod1 = "KASA"
    kod2 = ""
    kod3 = ""
ElseIf U.Cells(adeta, 20) = "KANAT" Then
    kod1 = "K "
    kod2 = T.Cells(WorksheetFunction.Match("" & U.Cells(adeta, 19), T.Range(palan), 0), 17)
    kod3 = ""
ElseIf U.Cells(adeta, 20) <> "KASA" And U.Cells(adeta, 20) <> "KANAT" Then
    
            If U.Cells(adeta, 18) = "" Then
                kod1 = ""
            Else
                kod1 = T.Cells(WorksheetFunction.Match("" & U.Cells(adeta, 18), T.Range(malan), 0), 14)
            End If
            
        If WorksheetFunction.CountIf(T.Range(palan), U.Cells(adeta, 19)) = 0 And U.Cells(adeta, 19) <> "" Then
            K.Cells(K.[A65536].End(3).Row + 1, 1) = "S" & adeta
            K.Cells(K.[A65536].End(3).Row, 2) = U.Cells(adeta, 19)
            kod2 = " "
        Else
            kod2 = " " & T.Cells(WorksheetFunction.Match("" & U.Cells(adeta, 19), T.Range(palan), 0), 17)
        End If
        
        If WorksheetFunction.CountIf(T.Range(salan), U.Cells(adeta, 20)) = 0 And U.Cells(adeta, 20) <> "" Then
            kod3 = ""
        Else
    kod3 = " " & T.Cells(WorksheetFunction.Match(U.Cells(adeta, 20), T.Range(salan), 0), 20)
        End If

End If

S.Cells(S.[K65536].End(3).Row + 1, 11) = Trim(kod1 & kod2 & kod3)
    
    S.Cells(S.[K65536].End(3).Row, 3) = U.Cells(adeta, 8)
    S.Cells(S.[K65536].End(3).Row, 4) = U.Cells(adeta, 9)
    S.Cells(S.[K65536].End(3).Row, 5) = U.Cells(adeta, 7)


If WorksheetFunction.CountIf(T.Range(aalan), U.Cells(adeta, 20)) = 0 And U.Cells(adeta, 20) <> "" Then
            K.Cells(K.[A65536].End(3).Row + 1, 1) = "T" & adeta
            K.Cells(K.[A65536].End(3).Row, 2) = U.Cells(adeta, 20)
    S.Cells(S.[K65536].End(3).Row, 7) = U.Cells(adeta, 20)
Else
S.Cells(S.[K65536].End(3).Row, 7) = T.Cells(WorksheetFunction.Match(Cells(adeta, 20), _
                                    T.Range(aalan), 0), 2)
End If
        
        
        If WorksheetFunction.CountIf(T.Range(dalan), U.Cells(adeta, 15)) = 0 And U.Cells(adeta, 15) <> "" Then
            K.Cells(K.[A65536].End(3).Row + 1, 1) = "O" & adeta
            K.Cells(K.[A65536].End(3).Row, 2) = U.Cells(adeta, 15)
            S.Cells(S.[K65536].End(3).Row, 8) = "KAP.LAKE"
                If U.Cells(adeta, 15) = "" Then
                    S.Cells(S.[K65536].End(3).Row, 9) = "KAPLAMA"
                Else
            S.Cells(S.[K65536].End(3).Row, 9) = T.Cells(WorksheetFunction.Match( _
                                                U.Cells(adeta, 15), T.Range(galan), 0), 8)
                End If
            Else
                S.Cells(S.[K65536].End(3).Row, 8) = T.Cells(WorksheetFunction.Match( _
                                                    U.Cells(adeta, 15), T.Range(dalan), 0), 5)
                S.Cells(S.[K65536].End(3).Row, 9) = T.Cells(WorksheetFunction.Match( _
                                                    U.Cells(adeta, 15), T.Range(galan), 0), 8)
                End If
    
    ElseIf sütun = 54 Then
        If U.Cells(adeta, 34) = "HARİÇ" Or U.Cells(adeta, 34) = "" Then GoTo 10
        
        
        If WorksheetFunction.CountIf(T.Range(valan), U.Cells(adeta, 34)) = 0 And U.Cells(adeta, 34) <> "" Then
            K.Cells(K.[A65536].End(3).Row + 1, 1) = "AH" & adeta
            K.Cells(K.[A65536].End(3).Row, 2) = U.Cells(adeta, 34)
            S.Cells(S.[K65536].End(3).Row + 1, 11) = U.Cells(adeta, 34)
        Else
        S.Cells(S.[K65536].End(3).Row + 1, 11) = T.Cells(WorksheetFunction.Match( _
                                                U.Cells(adeta, 34), T.Range(valan), 0), 23)
        End If
        
        S.Cells(S.[K65536].End(3).Row, 3) = U.Cells(adeta, 8)
        S.Cells(S.[K65536].End(3).Row, 4) = U.Cells(adeta, 9)
        S.Cells(S.[K65536].End(3).Row, 5) = U.Cells(adeta, 7)
        
        If WorksheetFunction.CountIf(T.Range(valan), U.Cells(adeta, 34)) = 0 And U.Cells(adeta, 34) <> "" Then
            K.Cells(K.[A65536].End(3).Row + 1, 1) = "AH" & adeta
            K.Cells(K.[A65536].End(3).Row, 2) = U.Cells(adeta, 34)
            S.Cells(S.[K65536].End(3).Row, 7) = U.Cells(adeta, 34)
        Else
        S.Cells(S.[K65536].End(3).Row, 7) = T.Cells(WorksheetFunction.Match( _
                                            U.Cells(adeta, 34), T.Range(valan), 0), 24)
        End If
        S.Cells(S.[K65536].End(3).Row, 8) = ""
        S.Cells(S.[K65536].End(3).Row, 9) = ""
10
        ElseIf sütun = 55 Then
        If U.Cells(adeta, 36) = "HARİÇ" Or U.Cells(adeta, 36) = "" Then GoTo 20
            
            
            If WorksheetFunction.CountIf(T.Range(yalan), U.Cells(adeta, 36)) = 0 And U.Cells(adeta, 36) <> "" Then
            K.Cells(K.[A65536].End(3).Row + 1, 1) = "AJ" & adeta
            K.Cells(K.[A65536].End(3).Row, 2) = U.Cells(adeta, 36)
            S.Cells(S.[K65536].End(3).Row + 1, 11) = U.Cells(adeta, 36)
            Else
            S.Cells(S.[K65536].End(3).Row + 1, 11) = T.Cells(WorksheetFunction.Match( _
                                                    U.Cells(adeta, 36) & "", T.Range(yalan), 0), 26)
            End If
            
            S.Cells(S.[K65536].End(3).Row, 3) = U.Cells(adeta, 8)
            S.Cells(S.[K65536].End(3).Row, 4) = U.Cells(adeta, 9)
            S.Cells(S.[K65536].End(3).Row, 5) = U.Cells(adeta, 7)
            
            If WorksheetFunction.CountIf(T.Range(yalan), U.Cells(adeta, 36)) = 0 And U.Cells(adeta, 36) <> "" Then
            K.Cells(K.[A65536].End(3).Row + 1, 1) = "AJ" & adeta
            K.Cells(K.[A65536].End(3).Row, 2) = U.Cells(adeta, 36)
            S.Cells(S.[K65536].End(3).Row, 7) = U.Cells(adeta, 36)
            Else
            S.Cells(S.[K65536].End(3).Row, 7) = T.Cells(WorksheetFunction.Match( _
                                                U.Cells(adeta, 36) & "", T.Range(yalan), 0), 27)
            End If
            
            S.Cells(S.[K65536].End(3).Row, 8) = ""
            S.Cells(S.[K65536].End(3).Row, 9) = ""
20
            ElseIf sütun = 56 Then
            If U.Cells(adeta, 38) = "HARİÇ" Or U.Cells(adeta, 38) = "" Then GoTo 30
                If WorksheetFunction.CountIf(T.Range(abalan), U.Cells(adeta, 38)) = 0 And U.Cells(adeta, 38) <> "" Then
            K.Cells(K.[A65536].End(3).Row + 1, 1) = "AL" & adeta
            K.Cells(K.[A65536].End(3).Row, 2) = U.Cells(adeta, 38)
                    S.Cells(S.[K65536].End(3).Row + 1, 11) = U.Cells(adeta, 38)
                Else
                    S.Cells(S.[K65536].End(3).Row + 1, 11) = T.Cells(WorksheetFunction.Match( _
                                                    U.Cells(adeta, 38) & "", T.Range(abalan), 0), 30)
                End If
                S.Cells(S.[K65536].End(3).Row, 3) = U.Cells(adeta, 8)
                S.Cells(S.[K65536].End(3).Row, 4) = U.Cells(adeta, 9)
                S.Cells(S.[K65536].End(3).Row, 5) = U.Cells(adeta, 7)
                
                If WorksheetFunction.CountIf(T.Range(abalan), U.Cells(adeta, 38)) = 0 And U.Cells(adeta, 38) <> "" Then
            K.Cells(K.[A65536].End(3).Row + 1, 1) = "AL" & adeta
            K.Cells(K.[A65536].End(3).Row, 2) = U.Cells(adeta, 38)
                    S.Cells(S.[K65536].End(3).Row, 7) = U.Cells(adeta, 38)
                Else
                S.Cells(S.[K65536].End(3).Row, 7) = T.Cells(WorksheetFunction.Match( _
                                                    U.Cells(adeta, 38) & "", T.Range(abalan), 0), 29)
                End If
                
                S.Cells(S.[K65536].End(3).Row, 8) = ""
                S.Cells(S.[K65536].End(3).Row, 9) = ""
30
                End If

If S.Cells(S.[K65536].End(3).Row - 1, 5) <> S.Cells(S.[K65536].End(3).Row, 5) Then
    S.Cells(S.[K65536].End(3).Row, 13) = WorksheetFunction.CountIf(U.Range("AB" & _
                                        G.Cells(sip, 2) & ":AB" & G.Cells(sip, 3)), ">210")
    S.Cells(S.[K65536].End(3).Row, 14) = WorksheetFunction.CountIf(U.Range("AD" & _
                                        G.Cells(sip, 2) & ":AD" & G.Cells(sip, 3)), ">27.5")
End If
                    
                    Else
                        If adeta + 1 > U.Cells(1, 43) Then
                            GoTo 44
                        Else
                            adeta = adeta + 1
                            GoTo 55
                        End If
                    End If
44
                Next
    Next
Next

' **** U SAYFASI KOŞULLU BİÇİM
If U.Cells(1, 1) = 1 Then
U.Cells.FormatConditions.Delete
biçimalanUO = "O2:O" & U.[G65536].End(3).Row
    U.Range(biçimalanUO).FormatConditions.Add Type:=xlExpression, Formula1:="=VE($O2<>"""";EĞERSAY(T!$D:$D;$O2)=0)"
    U.Range(biçimalanUO).FormatConditions(1).Interior.Color = 255
biçimalanUR = "R2:R" & U.[G65536].End(3).Row
    U.Range(biçimalanUR).FormatConditions.Add Type:=xlExpression, Formula1:="=VE($R2<>"""";EĞERSAY(T!$M:$M;$R2)+EĞERSAY(T!$S:$S;$R2)=0)"
    U.Range(biçimalanUR).FormatConditions(1).Interior.Color = 255
biçimalanUS = "S2:S" & U.[G65536].End(3).Row
    U.Range(biçimalanUS).FormatConditions.Add Type:=xlExpression, Formula1:="=VE($S2<>"""";EĞERSAY(T!$P:$P;$S2)=0)"
    U.Range(biçimalanUS).FormatConditions(1).Interior.Color = 255
biçimalanUT = "T2:T" & U.[G65536].End(3).Row
    U.Range(biçimalanUT).FormatConditions.Add Type:=xlExpression, Formula1:="=VE($T2<>"""";EĞERSAY(T!$A:$A;$T2)=0)"
    U.Range(biçimalanUT).FormatConditions(1).Interior.Color = 255
biçimalanUAH = "AH2:AH" & U.[G65536].End(3).Row
    U.Range(biçimalanUAH).FormatConditions.Add Type:=xlExpression, Formula1:="=VE($AH2<>"""";EĞERSAY(T!$V:$V;$AH2)=0)"
    U.Range(biçimalanUAH).FormatConditions(1).Interior.Color = 255
biçimalanUAJ = "AJ2:AJ" & U.[G65536].End(3).Row
    U.Range(biçimalanUAJ).FormatConditions.Add Type:=xlExpression, Formula1:="=VE($AJ2<>"""";EĞERSAY(T!$Y:$Y;$AJ2)=0)"
    U.Range(biçimalanUAJ).FormatConditions(1).Interior.Color = 255
biçimalanUAL = "AL2:AL" & U.[G65536].End(3).Row
    U.Range(biçimalanUAL).FormatConditions.Add Type:=xlExpression, Formula1:="=VE($AL2<>"""";EĞERSAY(T!$AB:$AB;$AL2)=0)"
    U.Range(biçimalanUAL).FormatConditions(1).Interior.Color = 255
End If

S.Range("C1:N1").AutoFilter Field:=12
U.Range("AO:BE").ClearContents

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
S.Activate

S.Columns("C:L").EntireColumn.AutoFit
S.Columns("F").ColumnWidth = 2.14
S.Columns("J").ColumnWidth = 2.14

' **** S SAYFASI KOŞULLU BİÇİM
If U.Cells(1, 2) = 1 Then
biçimalan = "C2:N" & S.[K65536].End(3).Row
    Cells.FormatConditions.Delete
    S.Range(biçimalan).FormatConditions.Add Type:=xlExpression, Formula1:="=$E2<>$E1"
    S.Range(biçimalan).FormatConditions(1).Borders(xlTop).LineStyle = xlContinuous
End If

U.Columns("AO:BE").Delete Shift:=xlToLeft

ActiveWindow.SmallScroll Down:=-1000
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

S.Cells(1, 2).Activate

If K.[A65536].End(3).Row = 1 And S.[K65536].End(3).Row = S.[L65536].End(3).Row Then
        MsgBox "İşleminiz;  " & Format(Timer - süre, "0.00") & " saniyede tamamlanmıştır."
Else
MsgBox "İşleminiz;  " & Format(Timer - süre, "0.00") & "  saniyede tamamlanmıştır." & Chr(10) & _
       " " & Chr(10) & "ANCAK;  " & _
       "ÜRETİM VERİLERİ Sayfasında Olup," & Chr(10) & _
       "KOD LİSTESİ sayfasında olmayan VERİLER var. " & Chr(10) & _
       " " & Chr(10) & _
       " " & Chr(10) & _
       "KODKONTROL sayfasındaki KODLARI KONTROL EDEREK," & Chr(10) & _
       "T  adlı sayfaya gerekli KOD EKLEMELERİNİ YAPINIZ.", vbInformation
End If

[B][COLOR="red"]End Sub[/COLOR][/B]

[B][COLOR="red"]Sub TEMİZLE()[/COLOR][/B]
Dim U As Worksheet: Set U = Sheets("UV")
Dim T As Worksheet: Set T = Sheets("T")
Dim S As Worksheet: Set S = Sheets("S")
Dim G As Worksheet: Set G = Sheets("GİRİŞ")
Dim K As Worksheet: Set K = Sheets("KODKONTROL")

    S.Columns("C:N").FormatConditions.Delete
    U.Columns("E:AN").FormatConditions.Delete
    U.Range("AO:BE").ClearContents
    S.Range("C:N").ClearContents
    K.Range("A:C").ClearContents

S.Range("C1") = "BAYİ": S.Range("D1") = "MÜŞTERİ": S.Range("E1") = "NUMARA"
S.Range("G1") = "TÜR": S.Range("H1") = "GRUP": S.Range("I1") = "RENK"
S.Range("K1") = "ÜRÜN KODU": S.Range("L1") = "ÜRÜN ADET"
S.Range("M1") = "ÖZEL BOY": S.Range("N1") = "ÖZEL EN"

K.Cells(1, 1) = "HÜCRE": K.Cells(1, 2) = "HÜCRE İÇERİĞİ"

Call KODLİSTESİ

U.Activate
ActiveWindow.SmallScroll Down:=-1000
U.Cells.FormatConditions.Delete
U.Cells(1, 4).Activate
[B][COLOR="red"]End Sub[/COLOR][/B]

[B][COLOR="red"]Sub KODLİSTESİ()[/COLOR][/B]
Dim U As Worksheet: Set U = Sheets("UV")
Dim G As Worksheet: Set G = Sheets("GİRİŞ")

G.Range("A:C").ClearContents
G.Cells(1, 1) = U.Cells(1, 7)
U.Range("G1:G" & U.[G65536].End(3).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=G.Range("A1"), Unique:=True
G.Cells(1, 2) = "BAŞ": G.Cells(1, 3) = "BİT"

With G.Range("B2:B" & G.[A65536].End(3).Row)
    .Formula = "=MATCH($A2,UV!$G:$G,0)"
    .Value = .Value
End With

With G.Range("C2:C" & G.[A65536].End(3).Row)
    .Formula = "=MATCH($A2,UV!$G:$G,0)+COUNTIF(UV!$G:$G,$A2)-1"
    .Value = .Value
End With
With G.Range("A2:C" & G.[A65536].End(3).Row + 10)
    .Interior.Color = xlNone
End With
[B][COLOR="red"]End Sub[/COLOR][/B]

y.selim · 31 Ekim 2015

1,5 K ve ÇİFT K ların olduğu siparişlerde yanlış sonuç veriyor.(örn.S15-3205)

İşlem tuşuna ilk bastığımda k.biçimlendirmeler hepsinde doğruydu sonradan tekrar basınca hepsinde karışık gidiyor.

Ömer BARAN · 31 Ekim 2015

Tüm kod metnini yukarıdaki ile değiştirdiğinize emin misiniz?
Ben bir'den fazla kez çalıştırıyorum ve koşullu biçimde sorun göremiyorum çünkü.

Yanlış olan hangi bilgidir?
--Eklenen satır adeti mi?
--K sütununa gelen ÜRÜN KODU mu?
--L sütununa yazılan sayı mı?

Bir de yukarıdaki kod'da 55 şeklinde bir satır var (mavi olarak renklendirdim,
o satırın birkaç satır üstündeki 53 sayısını 55 olarak (kırmızı işaretledim) değiştirerek deneyiniz.

Ömer BARAN · 31 Ekim 2015

3205 sipariş için olması gereken sonuçların tümünü satır satır yazar mısınız?
Ona göre bakayım isterseniz.
Bir önceki cevabımda yazdığım değişiklik, sadece MENTEŞE için 1,5 K, ÇİFT KANAT için 2 katını diğerleri için AG sütunundaki sayının dikkate alınmasını sağlar.

y.selim · 31 Ekim 2015

Ürün kodu ve sayı da hata veriyor
Dosya da örnekledim.

Ömer BARAN · 31 Ekim 2015

İlk fark ettiğimi söyleyeyim.

Satır oluşumunda T sütununun (1,5 K ve ÇİFT KANAT da bu sütunda bulunuyor) devre dışı kalmasını (T sütunundaki SÜRME kod'unun dikkate alınmaması için) siz istemiştiniz (47 numaralı cevap) ve ona göre belge oluşturarak eklemiştim (48 numaralı cevap).
Ardından 1,5 K ve ÇİFT KANAT için sadece MENTEŞE adetlerinde çift sayım olsun dediniz (o da son gönderdiğim kod cevabında gerçekleşti).

Şu anda ise 1,5 K ve ÇİFT KANAT için yine ayrı satır oluşmadığını yazdınız.

Neticede;
-- önce satır oluşumunun çözülmesi (T sütunundaki SÜRME-1,5K-ÇİFT KANAT ve belki de yarın eklenecek başka kodlar da dikkate alınacak demektir) lazım,
--ardından da sadece MENTEŞE sayıları için 2 katı olayının dahil edilmesi lazım.
KAPI dışındaki satır oluşumlarında ve adet saymada sorun yok diye görüyorum.

Satır oluşumu ile ilgili olarak yukarıdaki hususa göre cevap yazarsanız (ney yoksayılacak, ney için satır oluşacak) akşam bakarım.
Biraz bilgisayar başından kalkmam gerekiyor şu an. Akşama çözmüş oluruz sanırım.
Sağlıcakla.

Ömer BARAN · 31 Ekim 2015

Sanırım anladım, 1,5 K veya ÇİFT KANAT'ın satırında, S sütunundaki kod aynı olduğunda satır ekleme eksikliği var (sayım hatası da bundan kaynaklanıyor, ikisi birden çözülür) .

T sütununda SÜRME kod'u dışında bir önceki makro kod'a dönülecek, sayım kısmı da buna göre düzelecek. 1,5 K ve ÇİFT KANAT sadece menteşe kodlarında iki kat sayılacak.

İsteğiniz tam olarak bu sanırım.
Siz cevap yazın, akşam bakıp dönüş yaparım.

Bu arada sizin eklediğiniz son belgede kod'u birkaç kez çalıştırdım, koşullu biçimlendirmede sorun göremedim.

y.selim · 31 Ekim 2015

Satır oluşumunda 1,5 K ve ÇİFT K nın payı var.Ama sürmenin yok.
1,5 yada çift k olması ayrıca menteşe adedinin iki ile çarpılmasını gerektiriyor.

Selametle.

Ömer BARAN · 1 Kasım 2015

Merhabalar.

Yeniden düzenlenmiş belge ekte.
.

y.selim · 1 Kasım 2015

Merhaba
1,5 ve çift meselesi tamam.Ama sürme olduğu zaman aynı ürünü yine iki kere yazıyor.(örn. S15-27)
T de sürme olduğu zaman bunun ek satır oluşturmasını engelleyemiyor muyuz?
Ve k.biçimlendirme sorunu devam ediyor.Eğer ki olmuyorsa bu şekilde de kalabilir sürme olanları elle düzeltebiliriz.

Ömer BARAN · 1 Kasım 2015

Koşullu biçim hatası olacak şekilde ve S15-27 için olması gereken sonuçları yine sağ tarafa yazarak belgeyi tekrar yükler misiniz?

y.selim · 1 Kasım 2015

Dosya ekte.

Çok Değişkenli Verileri Kriterlere Göre Aktarma

Ömer BARAN

Uzman

Ekli dosyalar

y.selim

Ömer BARAN

Uzman

Ömer BARAN

Uzman

Ekli dosyalar

y.selim

Ömer BARAN

Uzman

y.selim

Ömer BARAN

Uzman

Ekli dosyalar

Ömer BARAN

Uzman

y.selim

Ömer BARAN

Uzman

Ömer BARAN

Uzman

y.selim

Ekli dosyalar

Ömer BARAN

Uzman

Ömer BARAN

Uzman

y.selim

Ömer BARAN

Uzman

Ekli dosyalar

y.selim

Ömer BARAN

Uzman

y.selim

Ekli dosyalar