üçlü veri doğrulama

gedavet · 21 Nisan 2011

Korhan bey alış sayfasını ekledim ancak olmadı
birde klm sünlarının yerine biraz daha sağda bir sütunları kullans agörünmese kullnalan alanda

Korhan Ayhan · 21 Nisan 2011

Selamlar,

Ekteki örnek dosyayı inceleyiniz. Dosya içinde gerekli açıklamaları yaptım.

gedavet · 21 Nisan 2011

yrd

Korhan bey ilginiz için teşekkür ederim

ekde bölgeler sayfasındaki bilgileri "satış" ve "gelir" sayfasındada nasıl uygularız

ÜRÜNLER SAYFASINDAKİ MANTIĞIN AYNISI

Korhan Ayhan · 22 Nisan 2011

Selamlar,

Bizler cevap verdikçe sürekli olarak dosyalarınızı güncelleyip farklı sütunlar için uygulamak istediğinizi belirtiyorsunuz.

Sizlere cevap verebilmek için kıymetli zamanlarımızı harcıyoruz. Lütfen kendi dosyalarınızdaki satır ve sütun bilgileriyle eşleşen örnek dosyaları foruma ekleyin. Bizleri sürekli olarak kodları revize etmek zorunda bırakıyorsunuz.

Bundan sonraki sorularınızda bu konuya lütfen özen gösteriniz.

Ekte örnek dosyanız üzerinde gerekli düzenlemeleri yaptım. İncelermisiniz.

gedavet · 13 Mayıs 2011

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Intersect(Target, Range("B5:B1048576")) Is Nothing Then Exit Sub

With Sheets("GELİR")
If UCase(Target) <> "TAKVİM" Then
.Columns("M:O").EntireColumn.Hidden = True
ElseIf UCase(Target) = "TAKVİM" Then
.Columns("M:O").EntireColumn.Hidden = False
End If
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Target.Column = 2 Or Target.Column = 4 Or Target.Column = 5 Or Target.Column = 9 Or Target.Column = 10 Or Target.Column = 11 Then
On Error Resume Next
Application.EnableEvents = False
Target.Value = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
Application.EnableEvents = True
Else
End If

"""" bu bölümde "Mustafa KOZA" şeklinde yapıyor
If Target.Column = 6 Or Target.Column = 7 Then
Dim i As Integer, deg, deg2 As String
On Error Resume Next
Application.EnableEvents = False
Target.Value = WorksheetFunction.Proper(Target.Value)
deg = Split(Target.Value, " ")
For i = LBound(deg) To UBound(deg) - 1
deg2 = deg2 & " " & deg(i)
Next
Target.Value = deg2 & " " & UCase(Replace(Replace(deg(UBound(deg)), "ı", "I"), "i", "İ"))
Target.Value = Right(Target.Value, Len(Target.Value) - 1)
Application.EnableEvents = True
End If

If Intersect(Target, [L5:M1048576]) Is Nothing Then Exit Sub
sat = Target.Row
Cells(sat, "N") = Round(Cells(sat, "M") * Cells(sat, "L"), 2) / 100
Cells(sat, "O") = Round(Cells(sat, "N") + Cells(sat, "L"), 2)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

24. mesajdaki dosyanın gelir syafasındaki koda bu kodları ilave etmek isityorum yardımcı olabilirmisiniz

gedavet · 13 Mayıs 2011

korhan hocam iyi günler 24. mesajdaki gelir sayfasına yukarıdaki kodları nasıl ekleriz yardımcı olabilirmisiniz

Korhan Ayhan · 13 Mayıs 2011

Selamlar,

Aşağıdaki kodu denermisiniz.

Kod:

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S2 As Worksheet, BUL As Range, ADRES As String, X As Byte, VERİ() As String, YENİ_VERİ As String
    
    On Error GoTo Son
    
    Set S2 = Sheets("BÖLGELER")
    S2.Range("AA4") = "BÖLGE"
    S2.Range("AB4") = "İL"
    S2.Range("AC4") = "İSİM"
    
    If Intersect(Target, Range("B5:M" & Rows.Count)) Is Nothing Then Exit Sub
    If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
    
    Application.EnableEvents = False
    
    If Target.Column = 2 Then
        With Sheets("GELİR")
            If UCase(Replace(Replace(Target, "ı", "I"), "i", "İ")) <> "TAKVİM" Then
                .Columns("M:O").EntireColumn.Hidden = True
            ElseIf UCase(Replace(Replace(Target, "ı", "I"), "i", "İ")) = "TAKVİM" Then
                .Columns("M:O").EntireColumn.Hidden = False
            End If
        End With
    
    ElseIf Target.Column = 2 Or Target.Column = 4 Or Target.Column = 5 Or Target.Column = 9 Or Target.Column = 10 Or Target.Column = 11 Then
        Target = UCase(Replace(Replace(Target, "ı", "I"), "i", "İ"))
    ElseIf Target.Column = 4 Then
        S2.Range("AB5:AB" & Rows.Count).ClearContents
        
        Set BUL = S2.Range("B:B").Find(Target, , , xlWhole)
        If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
            If BUL.Offset(0, 1) <> "" Then
                If WorksheetFunction.CountIf(S2.Range("AB:AB"), BUL.Offset(0, 1)) = 0 Then
                    S2.Cells(Rows.Count, "AB").End(3).Offset(1) = BUL.Offset(0, 1)
                End If
            End If
        Set BUL = S2.Range("B:B").FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
        S2.Range("AB5:AB" & Rows.Count).Sort Key1:=S2.Range("AB5"), Order1:=xlAscending
        S2.Cells.EntireColumn.AutoFit
        If Target = "" Then
            Application.EnableEvents = False
            Range("E" & Target.Row & ":F" & Target.Row).ClearContents
            Application.EnableEvents = True
        End If
        
    ElseIf Target.Column = 5 Then
    
        S2.Range("AC5:AC" & Rows.Count).ClearContents
        
        Set BUL = S2.Range("B:B").Find(Cells(Target.Row, "D"), , , xlWhole)
        If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
            If BUL.Offset(0, 1) <> "" And Target = BUL.Offset(0, 1) Then
                If WorksheetFunction.CountIf(S2.Range("AC:AC"), BUL.Offset(0, 2)) = 0 Then
                    S2.Cells(Rows.Count, "AC").End(3).Offset(1) = BUL.Offset(0, 2)
                End If
            End If
        Set BUL = S2.Range("B:B").FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
        S2.Range("AC5:AC" & Rows.Count).Sort Key1:=S2.Range("AC5"), Order1:=xlAscending
        S2.Cells.EntireColumn.AutoFit
    
    ElseIf Target.Column = 6 Or Target.Column = 7 Then
        Target = WorksheetFunction.Proper(Target)
        VERİ = Split(Target, " ")
        For X = LBound(VERİ) To UBound(VERİ) - 1
            YENİ_VERİ = YENİ_VERİ & " " & VERİ(X)
        Next
        Target = YENİ_VERİ & " " & UCase(Replace(Replace(VERİ(UBound(VERİ)), "ı", "I"), "i", "İ"))
        Target = Right(Target, Len(Target) - 1)
    
    ElseIf Target.Column = 12 Or Target.Column = 13 Then
        Cells(Target.Row, "N") = WorksheetFunction.Round(Cells(Target.Row, "M") * Cells(Target.Row, "L"), 2) / 100
        Cells(Target.Row, "O") = WorksheetFunction.Round(Cells(Target.Row, "N") + Cells(Target.Row, "L"), 2)
    End If
    
Son:
    Application.EnableEvents = True
    Set BUL = Nothing
    Set S2 = Nothing
End Sub

gedavet · 13 Mayıs 2011

korhan bey yeni eklediğiniz işlem ler tamam ancak önceki işlem olan bölge il isim ler çalışmıyor birde önceden kod iki bölüm dü,şimdi tek bölüm olmuş ondan olabilirmi

yani eski özellikle beraber yeni özelliği eklemek isityorum

gedavet · 13 Mayıs 2011

eski koda büyük küçük harf yapma kodunu ekleyince hata vermiyordu sadece sütunları gizleten kodu ekleyemiyordum

Korhan Ayhan · 13 Mayıs 2011

Selamlar,

Sizin sadece Worksheet_Change kodunu yenilemeniz gerekiyordu. Diğer koda dokunmayın.

gedavet · 13 Mayıs 2011

tamam anlaşıldı sadece üsteki bölümü değiştiriyorum alttaki aynen duruyor

gedavet · 13 Mayıs 2011

korhan hocam sayfanın birinde sütün gizleme büyük küçük harf yapan ve toplam çarpma yapan kod klasa diğerlerini sili verseniz yani bölge il isim işlemi olmadan bir kod lazım

Korhan Ayhan · 13 Mayıs 2011

Selamlar,

Aşağıdaki kodu kullanabilirsiniz.

Kod:

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim X As Byte, VERİ() As String, YENİ_VERİ As String
    
    On Error GoTo Son
    
    If Intersect(Target, Range("B5:M" & Rows.Count)) Is Nothing Then Exit Sub
    If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
    
    Application.EnableEvents = False
    
    If Target.Column = 2 Then
        With Sheets("GELİR")
            If UCase(Replace(Replace(Target, "ı", "I"), "i", "İ")) <> "TAKVİM" Then
                .Columns("M:O").EntireColumn.Hidden = True
            ElseIf UCase(Replace(Replace(Target, "ı", "I"), "i", "İ")) = "TAKVİM" Then
                .Columns("M:O").EntireColumn.Hidden = False
            End If
        End With
    
    ElseIf Target.Column = 2 Or Target.Column = 4 Or Target.Column = 5 Or Target.Column = 9 Or Target.Column = 10 Or Target.Column = 11 Then
        Target = UCase(Replace(Replace(Target, "ı", "I"), "i", "İ"))
    ElseIf Target.Column = 6 Or Target.Column = 7 Then
        Target = WorksheetFunction.Proper(Target)
        VERİ = Split(Target, " ")
        For X = LBound(VERİ) To UBound(VERİ) - 1
            YENİ_VERİ = YENİ_VERİ & " " & VERİ(X)
        Next
        Target = YENİ_VERİ & " " & UCase(Replace(Replace(VERİ(UBound(VERİ)), "ı", "I"), "i", "İ"))
        Target = Right(Target, Len(Target) - 1)
    
    ElseIf Target.Column = 12 Or Target.Column = 13 Then
        Cells(Target.Row, "N") = WorksheetFunction.Round(Cells(Target.Row, "M") * Cells(Target.Row, "L"), 2) / 100
        Cells(Target.Row, "O") = WorksheetFunction.Round(Cells(Target.Row, "N") + Cells(Target.Row, "L"), 2)
    End If
    
Son:
    Application.EnableEvents = True
End Sub

gedavet · 13 Mayıs 2011

korhan hocam çok teşekkür ederim

gedavet · 14 Mayıs 2011

Korhan hocam iyi günler iyi çalışmalar 24. Mesajdaki satış sayfasındaki kod bölge sayfasındaki veriler 130 satıra varınca son bölgeyi göstermiyor gelir sayfasında gösteriyor satışda göstermiyor

yardımcı olabilirmisiniz veriler uzayıp 130 satıra çoğaldığındam desem gelir sayfasında sorun yok satışdkai kod da bir sıkıntımı varki

gedavet · 14 Mayıs 2011

SELAMLAR KORHAN ABİ SATIŞ SAYFASINDAKİ KODDA BİR SIKINTI VAR YARDIMCI OLABİLİRMİSİNİZ

özür diliyorum meşkul ediyorum ya satış sayfasındaki sorunla ilgili
biraz düşündüm neden olabilir diye dün gelir sayfasında bir kod değişikliği yapıvermiştiniz herhalde ondan sonsonra oldu

şimdi bir kaç örnek denidm kodlardan değilmi bilmiyorum bölgeler sayfasındaki veiler çoğalınca mı oluyor bilemedim herhalde ondan mı bilmiyorum denediğim örnekde bölgeler deki veileir çoğaltıncaya kadar sıkıntı yoktu
BİR TÜRLÜ ÇÖZEMEDİM SATIŞ SAYFASININDAKİ BÖLGE SÜTUNUNDAKİ BİR HÜCREYİ TIKLAYINCA BÖLGELER SAYFASINDAKİ İLERİDE SAĞTARA OLUŞTIRDUĞU BÖLGELERİ DEĞİŞTİRİYOR ONDAN OLUYOR ANCAK NİYE DEĞİŞTİİRYOR HEPSİNİ EKLEMİYOR BİLEMEDİM BİR ÇÖZÜVEREBİLİRMİİSNİZ

gedavet · 16 Mayıs 2011

Korhan hocam 24. Mesajdaki örneğin bölgeler sayfasındaki verielri çoğalttım satış sayfasındaki bölgelerde de az çıkıyor
bu konuda yardımcı olabilirmisiniz
herhalda sorun bölgeler sayfasındaki verinin uzamasındanancak gelir sayfasında sıkıntı yok niye bilemedim

satış sayfasında bölgeler ve ürünler sayfası ile bağlantılı iki kod var gelirde yok acaba ondan olabilirmi

Korhan Ayhan · 16 Mayıs 2011

Selamlar,

#24 nolu mesajımdaki dosyayı indirdim.
BÖLGELER isimli sayfadaki bölge sayısını arttırdım.
SATIŞ isimli sayfayı açtım.
D sütunundaki herhangibir hücreye tıkladım.

Eklemiş olduğum yeni bölgeler listede göründü. Yani dosyada bir problem görünmüyor.

Korhan Ayhan · 16 Mayıs 2011

Selamlar,

Şimdi hatayı fark ettim. SATIŞ isimli sayfaya ait aşağıdaki kodda kırmızı renkle belirttiğim bölüm S1 olarak kalmış. S2 olarak düzeltirseniz sorun ortadan kalkacaktır.

Kod:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim S1 As Worksheet, S2 As Worksheet, BUL As Range, ADRES As String
    
    On Error GoTo Son
    
    Set S1 = Sheets("ÜRÜNLER")
    Set S2 = Sheets("BÖLGELER")
    S1.Range("AA4") = "KASA"
    S1.Range("AB4") = "GRUP"
    S1.Range("AC4") = "ÜRÜN ADI"
    S2.Range("AA4") = "BÖLGE"
    S2.Range("AB4") = "İL"
    S2.Range("AC4") = "İSİM"
    
    If Target.Row < 5 Then Exit Sub
    If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
    
    Application.EnableEvents = False
    
    S1.Range("B4:B" & S1.Cells(Rows.Count, 2).End(3).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=S1.Range("AA4"), Unique:=True
    S1.Range("AA5:AA" & Rows.Count).Sort Key1:=S1.Range("AA5"), Order1:=xlAscending
    If Cells(Target.Row, "B") = "" Then S1.Range("AB5:AC" & Rows.Count).ClearContents
    S2.Range("B4:B" & S[COLOR=red]2[/COLOR].Cells(Rows.Count, 2).End(3).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=S2.Range("AA4"), Unique:=True
    S2.Range("AA5:AA" & Rows.Count).Sort Key1:=S2.Range("AA5"), Order1:=xlAscending
    If Cells(Target.Row, "D") = "" Then S2.Range("AB5:AC" & Rows.Count).ClearContents
    
    If Target.Column = 9 And Cells(Target.Row, "B") <> "" Then
        S1.Range("AB5:AB" & Rows.Count).ClearContents
        
        Set BUL = S1.Range("B:B").Find(Cells(Target.Row, "B"), , , xlWhole)
        If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
            If BUL.Offset(0, 1) <> "" Then
                If WorksheetFunction.CountIf(S1.Range("AB:AB"), BUL.Offset(0, 1)) = 0 Then
                    S1.Cells(Rows.Count, "AB").End(3).Offset(1) = BUL.Offset(0, 1)
                End If
            End If
        Set BUL = S1.Range("B:B").FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
        S1.Range("AB5:AB" & Rows.Count).Sort Key1:=S1.Range("AB5"), Order1:=xlAscending
        S1.Cells.EntireColumn.AutoFit
        
    ElseIf Target.Column = 10 And Cells(Target.Row, "B") <> "" Then
    
        S1.Range("AC5:AC" & Rows.Count).ClearContents
        
        Set BUL = S1.Range("B:B").Find(Cells(Target.Row, "B"), , , xlWhole)
        If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
            If BUL.Offset(0, 1) <> "" And Cells(Target.Row, "I") = BUL.Offset(0, 1) Then
                If WorksheetFunction.CountIf(S1.Range("AC:AC"), BUL.Offset(0, 2)) = 0 Then
                    S1.Cells(Rows.Count, "AC").End(3).Offset(1) = BUL.Offset(0, 2)
                End If
            End If
        Set BUL = S1.Range("B:B").FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
        S1.Range("AC5:AC" & Rows.Count).Sort Key1:=S1.Range("AC5"), Order1:=xlAscending
        S1.Cells.EntireColumn.AutoFit
    
    ElseIf Target.Column = 5 And Cells(Target.Row, "D") <> "" Then
        S2.Range("AB5:AB" & Rows.Count).ClearContents
        
        Set BUL = S2.Range("B:B").Find(Cells(Target.Row, "D"), , , xlWhole)
        If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
            If BUL.Offset(0, 1) <> "" Then
                If WorksheetFunction.CountIf(S2.Range("AB:AB"), BUL.Offset(0, 1)) = 0 Then
                    S2.Cells(Rows.Count, "AB").End(3).Offset(1) = BUL.Offset(0, 1)
                End If
            End If
        Set BUL = S2.Range("B:B").FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
        S2.Range("AB5:AB" & Rows.Count).Sort Key1:=S2.Range("AB5"), Order1:=xlAscending
        S2.Cells.EntireColumn.AutoFit
    
    ElseIf Target.Column = 6 And Cells(Target.Row, "D") <> "" Then
    
        S2.Range("AC5:AC" & Rows.Count).ClearContents
        
        Set BUL = S2.Range("B:B").Find(Cells(Target.Row, "D"), , , xlWhole)
        If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
            If BUL.Offset(0, 1) <> "" And Cells(Target.Row, "E") = BUL.Offset(0, 1) Then
                If WorksheetFunction.CountIf(S2.Range("AC:AC"), BUL.Offset(0, 2)) = 0 Then
                    S2.Cells(Rows.Count, "AC").End(3).Offset(1) = BUL.Offset(0, 2)
                End If
            End If
        Set BUL = S2.Range("B:B").FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
        S2.Range("AC5:AC" & Rows.Count).Sort Key1:=S2.Range("AC5"), Order1:=xlAscending
        S2.Cells.EntireColumn.AutoFit
    End If
    
Son:
    Application.EnableEvents = True
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

gedavet · 16 Temmuz 2011

iyi çalışmalar 24. mesajdaki dosyaın gelir sayfasınında sarı dolgu olan yerler d sütunundan başlıyor soldan iki sütun silsek ve b sütunundan başlasa gelir sayfasındaki kodların nerelerini geğiştirmem lazım yardımcı olabilirmisiniz

üçlü veri doğrulama

gedavet

Ekli dosyalar

Korhan Ayhan

Administrator

Ekli dosyalar

gedavet

Ekli dosyalar

Korhan Ayhan

Administrator

Ekli dosyalar

gedavet

gedavet

Korhan Ayhan

Administrator

gedavet

gedavet

Korhan Ayhan

Administrator

gedavet

gedavet

Korhan Ayhan

Administrator

gedavet

gedavet

gedavet

gedavet

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator

gedavet