• DİKKAT

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

Su Analiz Raporları

O

omeryılmaz

Katılım
30 Kasım 2006
Mesajlar
411
Excel Vers. ve Dili
Excel 2007 - Türkçe
Dosyada açıklamalı olarak anlatılmıştır. Sularda bakteri varsa bakteri olanların protokol nolarının TexBox içersindeki KARAR yazısı içersine ( 1132 - 1135 - 1136 ) yazdırılması.

"KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre; (1132 - 1135 - 1136 ) protokol nolu numunelerin UYGUN OLMADIĞI diğer numunelerin UYGUN OLDUĞUNU bildirir rapordur."

Şayet suların hepsi temiz sıfır (0) ise örnektedi diğer kararın yazdırılması mümkünmü?

KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre;UYGUN OLDUĞUNU bildirir rapordur.
 
Son düzenleme:
Analiz sonuçlarını raporla

Saygı değer hocalarım . Öncelikle sevgi ve saygılarımı sunuyorum....
Aşağıda kayıtlı yazılımda, kodlar normal çalışmaktadır. Ancak eğer TexBoxlara girilen kayıtlardan hepsi 0 (sıfır) dan büyükse

TextBox763 = " KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre; (" & VERİ & ") protokol nolu numunelerin UYGUN OLMADIĞI, diğer numunelerin UYGUN OLDUĞUNU bildirir rapordur."

yazısında diğer numunelerin UYGUN OLDUĞUNU bildirir rapordur." cümlesi, temiz numune olmadığı için raporda anlamsız olmaktadır....

3. olasılık olarak TexBoxlara girilen analiz sonuçlarının hepsi 0 (sıfır) dan büyükse aşağıyı ekleyebilirmiyiz (1 ile 15 arası kayıt girilmekte)
'Else
'TextBox763 = " KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre; UYGUN OLMADIĞINI bildirir rapordur."


Private Sub CommandButton5_Click() ' kAYDET
On Error Resume Next
Worksheets("Rapor").Select
If TextBox2.Text = Empty Then
MsgBox ("Tarih Alanı Boş Bırakılamaz!"), vbCritical, Application.UserName
TextBox2.SetFocus
Exit Sub
End If
If Liste1.Text = Empty Then
MsgBox ("Num. Gönderen Alanı Boş Bırakılamaz!"), vbCritical, Application.UserName
Liste1.SetFocus
Exit Sub
End If
If ComboBox1.Text = Empty Then
MsgBox ("Ne Amaçla Alındığı Alanı Boş Bırakılamaz!"), vbCritical, Application.UserName
ComboBox1.SetFocus
Exit Sub
End If
If TextBox716.Text = Empty Then
MsgBox ("Laboratuvara Geliş Tarihi Alanı Boş Bırakılamaz!"), vbCritical, Application.UserName
TextBox716.SetFocus
Exit Sub
End If
ListBox6.Clear
Sheets("Rapor").Select
Sayfa15.Cells(7, "f") = TextBox2.Value
Sayfa15.Cells(11, "e") = Liste1.Value
Sayfa15.Cells(12, "e") = ComboBox1.Value
Sayfa15.Cells(13, "e") = TextBox714.Value
Sayfa15.Cells(14, "e") = TextBox715 & " / " & TextBox762.Value
Sayfa15.Cells(15, "e") = TextBox716.Value
Sayfa15.Cells(18, "b") = TextBox717.Value
Sayfa15.Cells(18, "c") = TextBox718.Value
Sayfa15.Cells(18, "f") = TextBox719.Value
Sayfa15.Cells(19, "b") = TextBox720.Value
Sayfa15.Cells(19, "c") = TextBox721.Value
Sayfa15.Cells(19, "f") = TextBox722.Value
Sayfa15.Cells(20, "b") = TextBox723.Value
Sayfa15.Cells(20, "c") = TextBox724.Value
Sayfa15.Cells(20, "f") = TextBox725.Value
Sayfa15.Cells(21, "b") = TextBox726.Value
Sayfa15.Cells(21, "c") = TextBox727.Value
Sayfa15.Cells(21, "f") = TextBox728.Value
Sayfa15.Cells(22, "b") = TextBox729.Value
Sayfa15.Cells(22, "c") = TextBox730.Value
Sayfa15.Cells(22, "f") = TextBox731.Value
Sayfa15.Cells(23, "b") = TextBox732.Value
Sayfa15.Cells(23, "c") = TextBox733.Value
Sayfa15.Cells(23, "f") = TextBox734.Value
Sayfa15.Cells(24, "b") = TextBox735.Value
Sayfa15.Cells(24, "c") = TextBox736.Value
Sayfa15.Cells(24, "f") = TextBox737.Value
Sayfa15.Cells(25, "b") = TextBox738.Value
Sayfa15.Cells(25, "c") = TextBox739.Value
Sayfa15.Cells(25, "f") = TextBox740.Value
Sayfa15.Cells(26, "b") = TextBox741.Value
Sayfa15.Cells(26, "c") = TextBox742.Value
Sayfa15.Cells(26, "f") = TextBox743.Value
Sayfa15.Cells(27, "b") = TextBox744.Value
Sayfa15.Cells(27, "c") = TextBox745.Value
Sayfa15.Cells(27, "f") = TextBox746.Value
Sayfa15.Cells(28, "b") = TextBox747.Value
Sayfa15.Cells(28, "c") = TextBox748.Value
Sayfa15.Cells(28, "f") = TextBox749.Value
Sayfa15.Cells(29, "b") = TextBox750.Value
Sayfa15.Cells(29, "c") = TextBox751.Value
Sayfa15.Cells(29, "f") = TextBox752.Value
Sayfa15.Cells(30, "b") = TextBox753.Value
Sayfa15.Cells(30, "c") = TextBox754.Value
Sayfa15.Cells(30, "f") = TextBox755.Value
Sayfa15.Cells(31, "b") = TextBox756.Value
Sayfa15.Cells(31, "c") = TextBox757.Value
Sayfa15.Cells(31, "f") = TextBox758.Value
Sayfa15.Cells(32, "b") = TextBox759.Value
Sayfa15.Cells(31, "c") = TextBox760.Value
Sayfa15.Cells(31, "f") = TextBox761.Value
For x = 719 To 761 Step 3
If Controls("TextBox" & x) > 0 And Controls("TextBox" & x) <> Empty Then
If VERİ = "" Then
VERİ = Controls("TextBox" & x - 2)
Else
VERİ = VERİ & " - " & Controls("TextBox" & x - 2)
End If
End If
Next
If VERİ <> "" Then
TextBox763 = " KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre; (" & VERİ & ") protokol nolu numunelerin UYGUN OLMADIĞI, diğer numunelerin UYGUN OLDUĞUNU bildirir rapordur."
Else
TextBox763 = " KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre; UYGUN OLDUĞUNU bildirir rapordur."


'*******EĞER TexBoxlara girilen kayıtlardan hepsi 0 (sıfır) dan büyükse...************
'Else
'TextBox763 = " KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre; UYGUN OLMADIĞINI bildirir rapordur."
End If
Sayfa15.Cells(34, "b") = TextBox763.Value
Sheets("Rapor").Range("B34").Font.Bold = False
Sheets("Rapor").Range("B34").Characters(InStr(1, Cells(34, 2), "KARAR"), Len("KARAR")).Font.Bold = True
Sheets("Rapor").Range("B34").Characters(InStr(1, Cells(34, 2), "İnsani"), Len("İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre;")).Font.Bold = True
Sheets("Rapor").Range("B34").Characters(InStr(1, Cells(34, 2), "UYGUN OLMADIĞI"), Len("UYGUN OLMADIĞI")).Font.Bold = True
Sheets("Rapor").Range("B34").Characters(InStr(1, Cells(34, 2), "UYGUN OLDUĞUNU"), Len("UYGUN OLDUĞUNU")).Font.Bold = True
Sayfa15.Cells(34, "ı") = TextBox763.Value
Sayfa15.Cells(38, "b") = Label196
Sayfa15.Cells(43, "b") = ComboBox2.Value
Sayfa15.Cells(44, "b") = ComboBox3.Value
Sayfa15.Cells(43, "f") = ComboBox4.Value
Sayfa15.Cells(44, "f") = ComboBox5.Value
Sayfa15.Cells(49, "c") = ComboBox6.Value
Sayfa15.Cells(50, "c") = ComboBox7.Value
End Sub
 

Ekli dosyalar

Son düzenleme:
Değerli üstatlarım olumlu veya olumsuz konu hakkında küçük bir fikir beyan edermisiniz.

saygılar..
 
Kodları biraz düzenledim, incleyin lütfen.
Mavi kısım; kodlarınızda kısaltma yapabilecek alternatif satırlar
Sarı kısım; hatalı olabileceğini değerlendirdiğim kısım (31 ler 32 mi olmalı?)
Kırmızı kısım; sıfır bakteri olmama durumuna göre eklenmiş satırlar.
Kod: 
Private Sub CommandButton5_Click()
On Error Resume Next
Worksheets("Rapor").Select
If TextBox2.Text = Empty Then
MsgBox ("Tarih Alanı Boş Bırakılamaz!"), vbCritical, Application.UserName
TextBox2.SetFocus
Exit Sub
End If
If Liste1.Text = Empty Then
MsgBox ("Num. Gönderen Alanı Boş Bırakılamaz!"), vbCritical, Application.UserName
Liste1.SetFocus
Exit Sub
End If
If ComboBox1.Text = Empty Then
MsgBox ("Ne Amaçla Alındığı Alanı Boş Bırakılamaz!"), vbCritical, Application.UserName
ComboBox1.SetFocus
Exit Sub
End If
If TextBox716.Text = Empty Then
MsgBox ("Laboratuvara Geliş Tarihi Alanı Boş Bırakılamaz!"), vbCritical, Application.UserName
CTextBox716.SetFocus
Exit Sub
End If
Sheets("Rapor").Select
Sayfa15.Cells(7, "f") = TextBox2.Value
Sayfa15.Cells(11, "e") = Liste1.Value
Sayfa15.Cells(12, "e") = ComboBox1.Value
Sayfa15.Cells(13, "e") = TextBox714.Value
Sayfa15.Cells(14, "e") = TextBox715 & " / " & TextBox762.Value
Sayfa15.Cells(15, "e") = TextBox716.Value
[COLOR=blue][B]'For i = 1 To 15[/B][/COLOR]
[B][COLOR=blue]'Sayfa15.Cells(i + 17, "b") = Controls("TextBox" & 714 + i * 3).Value[/COLOR][/B]
[B][COLOR=blue]'Sayfa15.Cells(i + 17, "c") = Controls("TextBox" & 715 + i * 3).Value[/COLOR][/B]
[B][COLOR=blue]'Sayfa15.Cells(i + 17, "f") = Controls("TextBox" & 716 + i * 3).Value[/COLOR][/B]
[B][COLOR=blue]'Next[/COLOR][/B]
Sayfa15.Cells(18, "b") = TextBox717.Value
Sayfa15.Cells(18, "c") = TextBox718.Value
Sayfa15.Cells(18, "f") = TextBox719.Value
Sayfa15.Cells(19, "b") = TextBox720.Value
Sayfa15.Cells(19, "c") = TextBox721.Value
Sayfa15.Cells(19, "f") = TextBox722.Value
Sayfa15.Cells(20, "b") = TextBox723.Value
Sayfa15.Cells(20, "c") = TextBox724.Value
Sayfa15.Cells(20, "f") = TextBox725.Value
Sayfa15.Cells(21, "b") = TextBox726.Value
Sayfa15.Cells(21, "c") = TextBox727.Value
Sayfa15.Cells(21, "f") = TextBox728.Value
Sayfa15.Cells(22, "b") = TextBox729.Value
Sayfa15.Cells(22, "c") = TextBox730.Value
Sayfa15.Cells(22, "f") = TextBox731.Value
Sayfa15.Cells(23, "b") = TextBox732.Value
Sayfa15.Cells(23, "c") = TextBox733.Value
Sayfa15.Cells(23, "f") = TextBox734.Value
Sayfa15.Cells(24, "b") = TextBox735.Value
Sayfa15.Cells(24, "c") = TextBox736.Value
Sayfa15.Cells(24, "f") = TextBox737.Value
Sayfa15.Cells(25, "b") = TextBox738.Value
Sayfa15.Cells(25, "c") = TextBox739.Value
Sayfa15.Cells(25, "f") = TextBox740.Value
Sayfa15.Cells(26, "b") = TextBox741.Value
Sayfa15.Cells(26, "c") = TextBox742.Value
Sayfa15.Cells(26, "f") = TextBox743.Value
Sayfa15.Cells(27, "b") = TextBox744.Value
Sayfa15.Cells(27, "c") = TextBox745.Value
Sayfa15.Cells(27, "f") = TextBox746.Value
Sayfa15.Cells(28, "b") = TextBox747.Value
Sayfa15.Cells(28, "c") = TextBox748.Value
Sayfa15.Cells(28, "f") = TextBox749.Value
Sayfa15.Cells(29, "b") = TextBox750.Value
Sayfa15.Cells(29, "c") = TextBox751.Value
Sayfa15.Cells(29, "f") = TextBox752.Value
Sayfa15.Cells(30, "b") = TextBox753.Value
Sayfa15.Cells(30, "c") = TextBox754.Value
Sayfa15.Cells(30, "f") = TextBox755.Value
Sayfa15.Cells(31, "b") = TextBox756.Value
Sayfa15.Cells(31, "c") = TextBox757.Value
Sayfa15.Cells(31, "f") = TextBox758.Value
Sayfa15.Cells(32, "b") = TextBox759.Value
Sayfa15.Cells([COLOR=yellow][B]31[/B][/COLOR], "c") = TextBox760.Value
Sayfa15.Cells([COLOR=yellow][B]31[/B][/COLOR], "f") = TextBox761.Value
For X = 719 To 761 Step 3
If Controls("TextBox" & X) > 0 And Controls("TextBox" & X) <> Empty Then
    If VERİ = "" Then
    VERİ = Controls("TextBox" & X - 2)
    Else
    VERİ = VERİ & " - " & Controls("TextBox" & X - 2)
    End If
[COLOR=red][B]ElseIf Controls("TextBox" & X) = 0 And Controls("TextBox" & X) <> Empty Then[/B][/COLOR]
[B][COLOR=red]   SıfırBakteri = SıfırBakteri + 1[/COLOR][/B]
End If
Next
If VERİ <> "" Then
[B][COLOR=red]    If SıfırBakteri > 0 Then
[/COLOR][/B]    TextBox763 = "         KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre;  (" & VERİ & ") protokol nolu numunelerin UYGUN OLMADIĞI diğer numunelerin UYGUN OLDUĞUNU bildirir rapordur."
[COLOR=red][COLOR=red][B] ElseIf SıfırBakteri = 0 Then
[/B][/COLOR][/COLOR][COLOR=red][B]    TextBox763 = "              KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre; UYGUN OLMADIĞINI bildirir rapordur."
[/B][/COLOR]    [COLOR=red][B]End If
[/B][/COLOR]Else
    TextBox763 = "              KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre;   UYGUN OLDUĞUNU bildirir rapordur."
End If

Sayfa15.Cells(34, "b") = TextBox763.Value
Sayfa15.Cells(34, "ı") = TextBox763.Value
Sayfa15.Cells(38, "b") = Label196
Sayfa15.Cells(43, "b") = ComboBox2.Value
Sayfa15.Cells(44, "b") = ComboBox3.Value
Sayfa15.Cells(43, "f") = ComboBox4.Value
Sayfa15.Cells(44, "f") = ComboBox5.Value
Sayfa15.Cells(49, "c") = ComboBox6.Value
Sayfa15.Cells(50, "c") = ComboBox7.Value
  For Each t In Range("B18:B32").Cells
    If t.Value = "" Then
    t.EntireRow.Hidden = True
  End If
  Next t
'If MsgBox("**LİSTE YAZDIRILMAYA HAZIR.**** YAZDIRILSIN MI?..****", vbQuestion + vbYesNo, "Dikkat") = vbNo Then Exit Sub
'Worksheets("Rapor").PrintOut
MsgBox "***LİSTE YAZDIRILDI**..**İ Y İ  Ç A L I Ş M A L A R ****"
For Each t In Range("B18:B32").Cells
    If t.Value = "" Then
    t.EntireRow.Hidden = False
  End If
  Next t
End Sub
 
Son düzenleme:
Hocam öncelikle ilginizden dolayı şükranlarımı sunuyorum.

Kısaltmalar çok müthiş ellerinize sağlık.

Ancak ;

For X = 719 To 761 Step 3
If Controls("TextBox" & X) > 0 And Controls("TextBox" & X) <> Empty Then
If VERİ = "" Then
VERİ = Controls("TextBox" & X - 2)
Else
VERİ = VERİ & " - " & Controls("TextBox" & X - 2)
End If
ElseIf Controls("TextBox" & X) = 0 And Controls("TextBox" & X) <> Empty Then
SıfırBakteri = SıfırBakteri + 1
End If
Next
If VERİ <> "" Then
TextBox763 = " KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre; (" & VERİ & ") protokol nolu numunelerin UYGUN OLMADIĞI diğer numunelerin UYGUN OLDUĞUNU bildirir rapordur."
ElseIf SıfırBakteri = 0 Then
TextBox763 = " KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre; UYGUN OLMADIĞINI bildirir rapordur."
Else
TextBox763 = " KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre; UYGUN OLDUĞUNU bildirir rapordur."
End If



Döngüsü yine eskisi gibi girilen analizlerin hepsi temiz veya bir kısmı kirli ise çalışıyor.
yeni değiştirilen bu döngüde ikiside çalışmadı
If VERİ <> "" Then
If SıfırBakteri > 0 Then
TextBox763 = " KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre; (" & VERİ & ") protokol nolu numunelerin UYGUN OLMADIĞI diğer numunelerin UYGUN OLDUĞUNU bildirir rapordur."
ElseIf SıfırBakteri = 0 Then
TextBox763 = " KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre; UYGUN OLMADIĞINI bildirir rapordur."
End If
Else
TextBox763 = " KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre; UYGUN OLDUĞUNU bildirir rapordur."
End If


Diğer girilen analizlerin hepsi kirli ise döngüsü çalışmadı ......... Saygılar...
 

Ekli dosyalar

Son düzenleme:
Kırmızı yazılı Else yazılmamış hata ondan kaynaklanıyor
Kod: 
If VERİ <> "" Then
    If SıfırBakteri > 0 Then
    TextBox763 = "         KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre;  (" & VERİ & ") protokol nolu numunelerin UYGUN OLMADIĞI diğer numunelerin UYGUN OLDUĞUNU bildirir rapordur."
ElseIf SıfırBakteri = 0 Then
    TextBox763 = "              KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre; UYGUN OLMADIĞINI bildirir rapordur."
    End If
[COLOR=red][B]Else[/B][/COLOR]
    TextBox763 = "              KARAR : Analizi yapılan bakteriyolojik su numunelerinin; Resmi Gazetede yayımlanan 17 Şubat 2005 tarih ve 25730 sayılı İnsani Tüketim Amaçlı Sular Hakkındaki Yönetmeliğe göre;   UYGUN OLDUĞUNU bildirir rapordur."
End If
 
şükranlarımı sunuyorum. Elinize emeğinize ve yüreğinize sağlık. Sağ olun var olun.
 
Ben teşekkür ederim, güle güle kullanın.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst