• DİKKAT

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

Aktif sayfanın sağındaki sayfalara koşullu veri girişi

  • Konbuyu başlatan Konbuyu başlatan s.savas
  • Başlangıç tarihi Başlangıç tarihi
Katılım
12 Ocak 2009
Mesajlar
838
Excel Vers. ve Dili
2003
Merhaba arkadaşlar.
Ekteki çalışma belgesinde bulunan ComboBox1'e döngü ile çalışma sayfalarının isimleri alınmıştır.
Kod:
For i = 1 To Sheets.Count
ComboBox1.AddItem Sheets(i).Name
Next i
ComboBox1.Value = Format(Date, "mmmm")
Aşağıdaki kod ile de aktif yılın hangi ayında isek o aya ait sayfa aktive edilmektedir.
Kod:
Private Sub ComboBox1_Click()
Application.ScreenUpdating = False
TextBox7.Text = DateSerial(Year(Now), ComboBox1.ListIndex + 1, 1)

On Error Resume Next
Sheets(ComboBox1.Text).Select
güncelleme2
cmdTEMİZLE_Click
Application.ScreenUpdating = True
End Sub
Sizlerden ricam şudur. Aşağıdaki koda ilave bir yazılarak veya mevcut kod revize edilerek
1-) TextBox5 ile sadece aktif olan sayfanın AK sütununa malzeme girişi yapılsın.
2-) Aktif olan sayfanın sağındaki veya ComboBox1 de görüntülenen aydan sonraki aylar için E sütununa (Aktif olan ay Mart olduğu için Nisan sayfasının E sütununa "=IF(RC[-3]="""","""",VLOOKUP(RC[-3],Mart!C[-3]:C[36],40,0))" formülünün yazılması) Takip eden aylar için; "=IF(RC[-3]="""","""",VLOOKUP(RC[-3],Nisan!C[-3]:C[36],40,0))" , "=IF(RC[-3]="""","""",VLOOKUP(RC[-3],Mayıs!C[-3]:C[36],40,0))" şeklinde formüllerin girilmesini sağlamak istiyorum.

Kod:
If OptionButton4.Value = True Then 'Yeni Kayıt
For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
If bak.Value = TextBox2.Value Then
MsgBox "Bu Kayıt numarası bulundu."
Exit Sub
End If

If TextBox2.Text = "" Then
MsgBox "Lütfen önce Malzemenin / İlacın Adını Giriniz...", , "Kayıt Hatası!!!"
Exit Sub
End If

If TextBox6.Text = "" Then
MsgBox "Lütfen Kritik Seviye Bilgisini Giriniz...", , "Kayıt Hatası!!!"
Exit Sub
End If

Next bak
For Each bak In Range("C1:C" & WorksheetFunction.CountA(Range("C1:C65000")))
If StrConv(bak.Value, vbUpperCase) = StrConv(TextBox2.Value, vbUpperCase) Then
MsgBox "" & TextBox2.Value & "Bu isminde bir kaydınız zaten mevcut, aynı malzemeden mükerrer kayıt yapamazsınız!"
Exit Sub
End If

Next bak
n = Cells(65536, 3).End(xlUp).Row - 4
Label9 = n

For i = 1 To Worksheets.Count
    With Sheets(i)
        Satır = .Cells(Rows.Count, "C").End(xlUp).Row + 1
        .Cells(Satır, "B").Value = Label9 * 1
        .Cells(Satır, "B").HorizontalAlignment = xlCenter
        .Cells(Satır, "C").Value = TextBox2.Value
        .Cells(Satır, "D").Value = TextBox8.Value
        .Cells(Satır, "AP").Value = TextBox6.Value
        .Cells(Satır, "A").Value = "=IF(RC[3]="""",0,RC[3]-R2C3)"
        .Cells(Satır, "AO").Value = "=SUM(RC[-5]:RC[-2])"
        .Cells(Satır, "AN").Value = "=SUM(RC[-34]:RC[-4])"
        .Cells(Satır, "AQ").Value = "=IF(AND(RC[-39]<=0),""Yok"",IF(AND(RC[-39]<RC[-1]),""Kritik"",IF(AND(RC[-39]>=RC[-1]),""Mevcut"")))"


    End With
Next i

MsgBox "" & TextBox2.Value & " Malzemesine Ait Yeni Kayıt Başarıyla Yapılmıştır. Malzeme Miktarını Tanımlamak İçin Lütfen Yeni Malzeme Girişi Seçeneğini Kullanınız. İyi Çalışmalar Dilerim", vbInformation, "Sn.  " & Application.UserName
Label9 = WorksheetFunction.Count(Range("b1:b65500")) + 1

Call TÜM_SAYFALARDA_SIRALAMA


cmdTEMİZLE_Click
ComboBox2_Change
TextBox2.SetFocus
Unload UserForm1
UserForm1.Show
End If
 

Ekli dosyalar

Değerli yorumlarınıza ihtiyacım var.
 
Geri
Üst