• DİKKAT

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

Hücre İçeriğine göre otomatik açılan userform

S

senkroniz

Katılım
26 Kasım 2008
Mesajlar
33
Excel Vers. ve Dili
2010 Tr
Herkese iyi günler.Forumda araştırdım,bir kaç konu da buldum fakat bir türlü uygulayamadım.Kod bilgim neredeyse yok.Hücre içeriğinde açılır listeden seçtiğim 2 kelimeden sadece 1'ini seçtiğimde userform açılsın ve girdiğim bilgiler o satırdaki eşleşen yerlere kayıt edilsin istiyorum.Yardımlarınızı bekliyorum.Detaylı anlatım eklediğim excel sayfasında mevcut.
 

Ekli dosyalar

. . .

KIRIK olduğunda B sütununda her zaman 1 mi yazacak.

. . .
 
Hüseyin Çoban hocam iyi günler,userformun açılmasına bağlı olan sütunu,kodun hangi kısmını düzelterek değiştirebilirim? 26.sütun yani Z sütununa "KIRIK" seçince açılması gereken tablom varda.
 
. . .

Sayfa1 kodları içerisinde
If Target.Column <> "1" Then Exit Sub şu satır ile
1. sütuna KIRIK yazılırsa açıl diye kodladım.

Ancak userform kodlarında C-D-E... yaz şeklinde kodladım.
Z sütununda userformu açsanız bile yine C-D-E... sütunlarına veri yazar.

. . .
 
Hocam veriyi işleyeceği yeri çözdüm onda problem yok.Cevabınız için teşekkür ederim.Ben o biri KIRIK yazınca çıkan 1 sandım.Teşekkürler tekrar. If Target.Column <> "26" Then Exit Sub olarak düzelttim.
 
Sayın Hüseyin Çoban Hocam sizi meşgul ediyorum kusuruma bakmayın.Kendi çalışma kitabıma aktarırken adım adım uyuşmazlık olabiliyor.Daha Önce aynı sayfanın içinde bir kod vardı.Bunuda ilave edince çakışma yaşıyor sanırım.Module olarak farklı yere kayıt ettim onda da çalışmadı kod.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("AX1,AZ1,BB1,BD1")) Is Nothing Then Exit Sub
Set s1 = Sheets("Sayfa1")

If Target.Value <> "" And Target.Cells.Count = 1 Then
    
    If Target.Column = 50 Then
        süt = 38
    ElseIf Target.Column = 52 Then
        süt = 40
    ElseIf Target.Column = 54 Then
        süt = 42
    ElseIf Target.Column = 56 Then
        süt = 44
    End If
    
    With s1.Range("B:B")
        Set Bul = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not Bul Is Nothing Then
            s1.Cells(Bul.Row, süt).Select
        End If
    End With
End If

Set Bul = Nothing
Set s1 = Nothing
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> "26" Then Exit Sub
If Target.Value = "KIRIK" Then
Target.Offset(0, 0).Select
Target.Offset(0, 1) = 1
UserForm1.Show
End If
End Sub
 
. . .

Şu şekilde deneyiniz.
Sayfa1 kod bölümü için;

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    
    If Target.Column <> "26" Then GoTo atla
    If Target.Value = "KIRIK" Then
        Target.Offset(0, 0).Select
        Target.Offset(0, 1) = 1
        UserForm1.Show
    End If
atla:
    
    If Intersect(Target, Range("AX1,AZ1,BB1,BD1")) Is Nothing Then Exit Sub
    Set s1 = Sheets("Sayfa1")
    
    If Target.Value <> "" And Target.Cells.Count = 1 Then
        
        If Target.Column = 50 Then
            süt = 38
            ElseIf Target.Column = 52 Then
            süt = 40
            ElseIf Target.Column = 54 Then
            süt = 42
            ElseIf Target.Column = 56 Then
            süt = 44
        End If
        
        With s1.Range("B:B")
            Set Bul = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
            If Not Bul Is Nothing Then
                s1.Cells(Bul.Row, süt).Select
            End If
        End With
    End If
    
    Set Bul = Nothing
    Set s1 = Nothing
End Sub

. . .
 
Hüseyin Çoban hocam,"KIRIK" seçildiğinde userform açılıyor, oraya girdiğimiz bilgileri işlediği hücreler kilitli olması gerekti.Hücreleri kilitleyincede "Application-defined or object-defined error" hatası veriyor.Çözümü varmıdır?
 
. . .

Sayfa korumasında şifre var mı. Ona göre kodlama biraz daha değişir.

Kod: 
Private Sub CommandButton1_Click()
    With Sheets("Sayfa1")
      [B][COLOR="DarkRed"]  .Unprotect[/COLOR][/B]
        .Cells(ActiveCell.Row, "C") = TextBox1 * 1
        .Cells(ActiveCell.Row, "D") = TextBox2 * 1
        .Cells(ActiveCell.Row, "E") = TextBox3 * 1
        .Cells(ActiveCell.Row, "F") = TextBox4 * 1
        .Cells(ActiveCell.Row, "G") = TextBox5 * 1
    [B][COLOR="DarkRed"]    .Protect[/COLOR][/B]
    End With
    Unload Me
End Sub

. . .
 
Şifre yok hocam şimdilik kodunuz çalışıyor.1234 şifresine görede kod yazarsanız bana ileride doğabilecek sıkıntıları ortadan kaldırmış olurum.Çok teşekkürler.
 
. . .

Kod: 
.Unprotect Password:="1234"
.protect Password:="1234"

. . .
 
Emeğinize sağlık,tamamı için çok teşşekür ediyorum.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst