• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

  • Konbuyu başlatan Konbuyu başlatan y.selim
  • Başlangıç tarihi Başlangıç tarihi
Son eklediğiniz belgeye bakmadan yazdım.

Bir de S15-1720 sipariş için sonuçları ekleseniz iyi olur.

Bunu sorma nedenim tam olarak şudur.
SÜRME bigisinin olduğu satırda yer alan adet rakamı hangi satıra dahil edilecek onu anlamak istiyorum,
SÜRME bilgisinin olduğu siparişte bir'den fazla sayıda diğer kod olduğunda ne olacak?
 
Son düzenleme:
Bir önceki dosya güncellenmiştir.

Sürmenin satır oluşturma ekstra bir dahli yok.Sadece kapı türünü belirtiyor. T de sürme olduğu zaman sadece kilidi (AH) etkiliyor.AH de otomatik sürme yada hariç oluyor.

Yani T deki sürmeyi "TEK" gibi kabul edebiliriz.
 
S15-82 numaralı siparişte SÜRME kod'unun bulnduğu satırlarda S sütununda 444C kod'u var.
Yani 444C-SÜRME yerine 444C-TEK olarak düşüneceğiz ama bu siparişte T sütununda TEK, S sütununda 444C olan satır hiç satır yok,
bu durumda SÜRME için 444C - TEK miş gibi yeni satır mı oluşacak, yoksa SÜRMEye ait adetleri hangisine dahil edeceğini nasıl anlayacağız?
 
Burda ve her yerde SÜRME yi TEK gibi kabul edebiliriz
Diyelim ki burda sürmenin haricinde TEK olan 444C ler de var onlar da yine aynı kabul edilip sadece 444C için bir satır oluşturulacak.Çünkü 444C tek bir çeşit ürün tek yada sürme fark etmiyor.
 
Başka 444C-TEK olsaydı onun toplamına dahil edilecekti,
olmadığına göre 444C-TEK miş gibi düşünüp yeni satır açılacak. Doğru mudur?
 
Başka sorun/ihtiyaç yok umarım.

Bu arada, vakit geç oldu, sabah vatandaşlık görevimizi hallettikten sonra belgeyi yenileyerek gönderirim. Şimdi yaparsam başka hata ihtimali var, yoruldum. Konuyu sabaha dek biraz demlenmeye bırakalım en iyisi.
 
Sanırım başka yok
Elbette ki sizi zaten fazlasıyla yorduk.
Hayırlı geceler.
 
Merhaba.

Belge ekte.
Umarım bu sefer eksiksiz çalışıyordur.

Kod'u çalıştırmadan S adlı sayfadaki sonuçları kontrol ediniz.
 

Ekli dosyalar

Son düzenleme:
Aşağıdaki sipariş numaralarında ilk kez fark ettiğim bir husus var,
ona özellikle bakıp, yanlış ise nedenini net olarak açıklayınız.

SİPARİŞ: S15-49 -> TÜR -> KASA 1,5 GRUP -> BOŞ RENK -> BOŞ (O sütunu BOŞ) ÜRÜN KODU -> M KASA
SİPARİŞ: S15-103 -> TÜR ->KASA ÇİFT GRUP -> BOŞ RENK -> BOŞ (O sütunu BOŞ) ÜRÜN KODU -> M KASA

şeklinde oluşuyor.
 
Son düzenleme:
Onların hiçbir önemi yok çok nadiren karşılaştığımız durumlar.Elle rahat bir şekilde düzeltebiliriz.
 
Sayın Baran makro da uzmanlık bilginizin olmadığını ifade etmenize rağmen çok ustaca bir iş çıkardınız.
Pek çok kişiniz karışık bulup el atmaktan çekindiği bir dosyayı uzun uğraşlar sonucu hitama erdirdiniz.
Göstermiş olduğunuz cesaret,azim ve kararlılık her türlü teşekkür ve takdirin üzerindedir.Sizi tebrik ederim. Elinize,emeğinize,aklınıza sağlık.
Excelle birlikte uzun bir ömür geçirmenizi dilerim.
 
Tekrar merhabalar.

KOD'a birkaç dokunuş yaptım.
-- son cevabımdaki sorun da düzeldi KASA, KASA 1,5 ve KASA ÇİFT için ÜRÜN KODU sütununa SADECE KASA yazılıyor.
-- kod metnine eklediğim kısa NOTlarla hangi kod satırında veya bölümünde hangi işlemin yapıldığını belirttim
(kod'u uyguladıktan sonra VBA ekranında YEŞİL renkli olarak göreceğiniz kısımlar).
-- kod metnine girintiler ekleyerek işlem sırasını ve işleyişi daha anlaşılır hale getirdim.
Böylece ben veya başkası tarafından kod'da değişiklik yapma ihtiyacı olduğunda hangi kısıma müdahale edileceği daha anlışılır olacak.

Sanırım böylece hiç bir açıkta kalan seçenek veya yanlış durum kalmamış oldu.

Belgenizi açıp kodların tümünü silip, yerine aşağıdakini ekleyin.

NOT: Kullandığınız düğmeye sağ tıklayıp, MAKRO ATA'yı seçin,
açılan listeden SATIR_EKLE_VERİ_YAZ'ı seçmeniz gerekiyor. Çünkü kod'un adını değiştirdim.
Kod: 
[B][COLOR="blue"]Sub SATIR_EKLE_VERİ_YAZ()[/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
[COLOR="YellowGreen"][B]'***HAZIRLIK BAŞLANGIÇ[/B][/COLOR]
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
    
    With U.Range("AP2:AP" & U.[G65536].End(3).Row)
        .Formula = "=IF(T2=""SÜRME"",""TEK"",T2)"
        .Value = .Value
    End With
[B][COLOR="yellowgreen"]'***HAZIRLIK BİTİŞ[/COLOR][/B]

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 = 43 To 46
        For sat = U.Cells(1, 42) To U.Cells(1, 43)
            If sütun = 43 Then
                U.Cells(sat, 47) = U.Cells(sat, 7) & " | " & U.Cells(sat, 15) & _
                " | " & U.Cells(sat, 18) & " | " & U.Cells(sat, 19) & " | " & U.Cells(sat, 42)
            ElseIf sütun = 44 Then
                    If U.Cells(sat, 34) <> "HARİÇ" Then
                        U.Cells(sat, 47) = U.Cells(sat, 7) & " | " & U.Cells(sat, 34)
                    Else
                        U.Cells(sat, 47) = ""
                    End If
            ElseIf sütun = 45 Then
                    If U.Cells(sat, 36) <> "HARİÇ" Then
                        U.Cells(sat, 47) = U.Cells(sat, 7) & " | " & "" & U.Cells(sat, 36)
                    Else
                        U.Cells(sat, 47) = ""
                    End If
            ElseIf sütun = 46 Then
                    If U.Cells(sat, 38) <> "HARİÇ" Then
                        U.Cells(sat, 47) = U.Cells(sat, 7) & " | " & "" & U.Cells(sat, 38)
                    Else
                        U.Cells(sat, 47) = ""
                    End If
            End If
        Next
                For adeta = U.Cells(1, 42) To U.Cells(1, 43)
                    alan2 = "AU" & U.Cells(1, 42) & ":AU" & U.Cells(1, 43)
                        If sütun = 45 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
45 [B][COLOR="yellowgreen"]'*******ÜRÜN KODU OLUŞTURULUYOR[/COLOR][/B]
                            If WorksheetFunction.CountIf(U.Range("AU" & U.Cells(1, 42) & _
                                                    ":AU" & adeta), U.Cells(adeta, 47)) = 1 Then
                            On Error Resume Next
                                If sütun = 43 Then
                                    If U.Cells(adeta, 42) = "KASA" _
                                        Or U.Cells(adeta, 42) = "KASA 1,5" _
                                        Or U.Cells(adeta, 42) = "KASA ÇİFT" Then
                                        kod1 = "KASA"
                                        kod2 = ""
                                        kod3 = ""
                                    ElseIf U.Cells(adeta, 42) = "KANAT" Then
                                        kod1 = "K "
                                        kod2 = T.Cells(WorksheetFunction.Match("" & U.Cells(adeta, 19), T.Range(palan), 0), 17)
                                        kod3 = ""
                                    ElseIf U.Cells(adeta, 42) <> "KASA" And U.Cells(adeta, 42) <> "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 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, 42)) = 0 Then
                                                    kod3 = ""
                                                Else
                                                    kod3 = " " & T.Cells(WorksheetFunction.Match(U.Cells(adeta, 42), _
                                                                                            T.Range(salan), 0), 20)
                                                End If
                                End If                              [B][COLOR="yellowgreen"]'ÜRÜN KODU OLUŞTURULDU[/COLOR][/B]
                                    
                                    S.Cells(S.[K65536].End(3).Row + 1, 11) = Trim(kod1 & kod2 & kod3)    [B][COLOR="yellowgreen"]'***KAPI SATIRI AÇILDI[/COLOR][/B]
                                    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, 42)) = 0 _
                                                                                        And U.Cells(adeta, 42) <> "" Then
                                                        K.Cells(K.[A65536].End(3).Row + 1, 1) = "AP" & adeta
                                                        K.Cells(K.[A65536].End(3).Row, 2) = U.Cells(adeta, 42)
                                                        S.Cells(S.[K65536].End(3).Row, 7) = U.Cells(adeta, 42)
                                                    Else
                                                        S.Cells(S.[K65536].End(3).Row, 7) = T.Cells(WorksheetFunction.Match( _
                                                                                                        U.Cells(adeta, 42), _
                                                        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 = 44 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                                                              [COLOR="yellowgreen"][B]'***KİLİT SATIRI AÇILDI[/B][/COLOR]
                                        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 = 45 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                                                              [B][COLOR="yellowgreen"]'***MENTEŞE SATIRI AÇILDI[/COLOR][/B]
                                        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 = 46 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                                                              [B][COLOR="yellowgreen"]'***KOL SATIRI AÇILDI[/COLOR][/B]
                                        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
                                    S.Cells(S.[L65536].End(3).Row + 1, 12) = WorksheetFunction.SumIf(U.Range(alan2), _
                                                                "" & U.Cells(adeta, 47), U.Range(alan3))
                                        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")         [B][COLOR="yellowgreen"]'***ÖZEL BOY ADET[/COLOR][/B]
                                            S.Cells(S.[K65536].End(3).Row, 14) = WorksheetFunction.CountIf(U.Range("AD" & _
                                            G.Cells(sip, 2) & ":AD" & G.Cells(sip, 3)), ">27.5")         [B][COLOR="yellowgreen"]'***ÖZEL EN ADET[/COLOR][/B]
                                        End If
                                Else
                                    If adeta + 1 > U.Cells(1, 43) Then
                                        GoTo 44
                                    Else
                                        adeta = adeta + 1
                                        GoTo 45
                                    End If
                                End If
44
                Next
    Next
Next
[B][COLOR="yellowgreen"]' **** U SAYFASI KOŞULLU BİÇİM BAŞLANGICI[/COLOR][/B]
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
[B][COLOR="yellowgreen"]' **** U SAYFASI KOŞULLU BİÇİM BİTİŞ[/COLOR][/B]

S.Range("C1:N1").AutoFilter Field:=12
U.Range("AO:AU").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

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

U.Columns("AO:AU").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="blue"]End Sub[/COLOR][/B]

[COLOR="blue"][B]Sub TEMİZLE()[/B][/COLOR]
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.Range("C1:N1").AutoFilter
    S.Columns("C:N").FormatConditions.Delete
    U.Columns("E:AN").FormatConditions.Delete
    U.Columns("AO:AU").Delete Shift:=xlToLeft
    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="blue"]End Sub[/COLOR][/B]

[B][COLOR="blue"]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="Blue"]End Sub[/COLOR][/B]
 
Son düzenleme:
Daha kullanışlı oldu. Çok teşekkürler hocam elleriniz dert görmesin.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst