[Yardım]  Raporlama İçin Liste Oluşturma Hakkında..

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Raporlama İçin Liste Oluşturma Hakkında..

İleti#1)  yesim_gurol » 10 Ekm 2018 21:12

Merhabalar,

Hastane programından çektiğim hasta bilgilerini kullanarak , manuel olarak hasta raporları hazırlamaktayım. Ekte ki dosyam üzerinde açıklama yapmaya çalıştım. Kısaca anlatmam gerekir ise şöyle ki;
Hastane programından excel sayfasına almış olduğum hasta listelerindeki bilgilerin bazı kısımlarını kullanarak yeni bir liste oluşturuyorum. Aslında programdan çekmiş olduğum bilgileri rapor hazırlarken kolaylık olması açısından kendime göre temiz bir liste oluşturuyorum. (barkod no, istek tarihi, sonuç v.s.)
Oluşturduğum bu listeyi acaba otomatik hale getire bilir miyiz?
3 - 5 hasta için sorun olmuyor elbette ki fakat 50 - 100 hasta olduğundan oldukça zahmetli oluyor. [uzgun]
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
yesim_gurol
Yeni Başlamış
 
Kayıt: 10 Haz 2018 12:35
Meslek: Hemşire
Yaş: 35
İleti: 80
 
Cinsiyet: Bayan
Bulunduğunuz İl / Semt: kayseri

Cevap: Raporlama İçin Liste Oluşturma Hakkında..

İleti#2)  askmadige34 » 10 Ekm 2018 23:14

Kod: Tümünü seç
Private Sub CommandButton1_Click()
Dim baslangic As Long, bitis As Long
Dim kelime() As String, kelime1 As String
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("HASTA LİSTESI")
Set s2 = Sheets("LİSTE")
Dim son As Long
son = s2.Range("C" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
On Error Resume Next
baslangic = TextBox1.Text
bitis = TextBox2.Text
For i = baslangic + 1 To bitis + 1
    If s1.Cells(i, 3) = "" Then Exit For
    son = son + 1
    s2.Cells(son, "C") = s1.Cells(i, "D")
    kelime = Split(s1.Cells(i, "E"), " ")
    For x = LBound(kelime) To UBound(kelime)
        kelime1 = kelime1 & " " & UCase(Left(kelime(x), 2))
    Next x
    s2.Cells(son, "D") = kelime1 & " " & Right(s1.Cells(i, "F"), 2)
    s2.Cells(son, "E") = Format(s1.Cells(i, "G"), "dd.mm.yyyy")
    s2.Cells(son, "F") = Split(s1.Cells(i, "H"), "/")(0)
    s2.Cells(son, "G") = s1.Cells(i, "I")
    kelime1 = Empty
    kelime = Empty
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub
askmadige34
Forum Moderatörü
 
Kayıt: 20 Kas 2015 13:04
Meslek: memur
Yaş: 38
İleti: 1583
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kayseri

Cevap: Raporlama İçin Liste Oluşturma Hakkında..

İleti#3)  Enes Recep BAĞ » 10 Ekm 2018 23:21

Kod: Tümünü seç
Private Sub CommandButton2_Click()
If TextBox1.Text = Empty Then MsgBox "Ltfen başlangıç sayısını giriniz.", 64, "UYARI": Exit Sub
If TextBox2
.Text = Empty Then MsgBox "Ltfen bitiş sayısını giriniz.", 64, "UYARI": Exit Sub

For ilk 
= TextBox1.Value To TextBox2.Value
    son 
= Sayfa2.Range("C65536").End(3).Row + 1
Sayfa2
.Cells(son, 3) = Sayfa1.Cells(ilk, 4)
sayı = InStr(Sayfa1.Cells(ilk, 5), " ") + 1
sondan 
= Mid(Sayfa1.Cells(ilk, 6), Len(Sayfa1.Cells(ilk, 6)) - 1, Len(Sayfa1.Cells(ilk, 6)))
Sayfa2.Cells(son, 4) = Mid(Sayfa1.Cells(ilk, 5), 1, 2) & " " & Mid(Sayfa1.Cells(ilk, 5), sayı, 2) & " " & sondan
Sayfa2
.Cells(son, 5) = Sayfa1.Cells(ilk, 6)

sayım = InStr(Sayfa1.Cells(ilk, 8), "/") - 2
Sayfa2
.Cells(son, 6) = Mid(Sayfa1.Cells(ilk, 8), 1, sayım)

Sayfa2.Cells(son, 7) = Sayfa1.Cells(ilk, 9)
Next ilk
End Sub
Kullanıcı avatarı
Enes Recep BAĞ
Forum Moderatörü
 
Adı Soyadı:Enes Recep BAĞ
Kayıt: 30 Ağu 2010 17:39
Konum: 0 549 808 82 66
Meslek: Bilgi işlem
Yaş: 36
İleti: 8248
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray / Merkez

Cevap: Cevap: Raporlama İçin Liste Oluşturma Hakkında..

İleti#4)  yesim_gurol » 11 Ekm 2018 09:36

askmadige34 yazdı:
Kod: Tümünü seç
Private Sub CommandButton1_Click()
Dim baslangic As Long, bitis As Long
Dim kelime() As String, kelime1 As String
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("HASTA LİSTESI")
Set s2 = Sheets("LİSTE")
Dim son As Long
son = s2.Range("C" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
On Error Resume Next
baslangic = TextBox1.Text
bitis = TextBox2.Text
For i = baslangic + 1 To bitis + 1
    If s1.Cells(i, 3) = "" Then Exit For
    son = son + 1
    s2.Cells(son, "C") = s1.Cells(i, "D")
    kelime = Split(s1.Cells(i, "E"), " ")
    For x = LBound(kelime) To UBound(kelime)
        kelime1 = kelime1 & " " & UCase(Left(kelime(x), 2))
    Next x
    s2.Cells(son, "D") = kelime1 & " " & Right(s1.Cells(i, "F"), 2)
    s2.Cells(son, "E") = Format(s1.Cells(i, "G"), "dd.mm.yyyy")
    s2.Cells(son, "F") = Split(s1.Cells(i, "H"), "/")(0)
    s2.Cells(son, "G") = s1.Cells(i, "I")
    kelime1 = Empty
    kelime = Empty
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub



Sayın ,askmadige34 ilginize çok teşekkür ederim. Tam istediğim şekilde oldu. şkşk [TESEKKÜR] Lakin küçük bir ricam olsa :oops:
Şöyle ki ;
Sayfa 2 (LİSTE sayfası) de ki H sütununa da günün tarihini yazdırabilir miyiz acaba :oops: :oops:
Kullanıcı avatarı
yesim_gurol
Yeni Başlamış
 
Kayıt: 10 Haz 2018 12:35
Meslek: Hemşire
Yaş: 35
İleti: 80
 
Cinsiyet: Bayan
Bulunduğunuz İl / Semt: kayseri

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Cevap: Raporlama İçin Liste Oluşturma Hakkında..

İleti#5)  yesim_gurol » 11 Ekm 2018 09:39

Enes Recep BAĞ yazdı:
Kod: Tümünü seç
Private Sub CommandButton2_Click()
If TextBox1.Text = Empty Then MsgBox "Ltfen başlangıç sayısını giriniz.", 64, "UYARI": Exit Sub
If TextBox2
.Text = Empty Then MsgBox "Ltfen bitiş sayısını giriniz.", 64, "UYARI": Exit Sub

For ilk 
= TextBox1.Value To TextBox2.Value
    son 
= Sayfa2.Range("C65536").End(3).Row + 1
Sayfa2
.Cells(son, 3) = Sayfa1.Cells(ilk, 4)
sayı = InStr(Sayfa1.Cells(ilk, 5), " ") + 1
sondan 
= Mid(Sayfa1.Cells(ilk, 6), Len(Sayfa1.Cells(ilk, 6)) - 1, Len(Sayfa1.Cells(ilk, 6)))
Sayfa2.Cells(son, 4) = Mid(Sayfa1.Cells(ilk, 5), 1, 2) & " " & Mid(Sayfa1.Cells(ilk, 5), sayı, 2) & " " & sondan
Sayfa2
.Cells(son, 5) = Sayfa1.Cells(ilk, 6)

sayım = InStr(Sayfa1.Cells(ilk, 8), "/") - 2
Sayfa2
.Cells(son, 6) = Mid(Sayfa1.Cells(ilk, 8), 1, sayım)

Sayfa2.Cells(son, 7) = Sayfa1.Cells(ilk, 9)
Next ilk
End Sub



Enes Bey, merhabalar..İlginiz ve çözüm için alternatifiniz için çok çok teşekkür ederim. şkşk --)(
Yalnız , çalıştırdığımda uyarı penceresi çıktı. Kodlara baktığımda aşağıdaki kısımı sarı olarak gördüm. [ilginc]
Kod: Tümünü seç
Sayfa2.Cells(son, 6) = Mid(Sayfa1.Cells(ilk, 8), 1, sayım)
Kullanıcı avatarı
yesim_gurol
Yeni Başlamış
 
Kayıt: 10 Haz 2018 12:35
Meslek: Hemşire
Yaş: 35
İleti: 80
 
Cinsiyet: Bayan
Bulunduğunuz İl / Semt: kayseri


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: canpolat00, Google [Bot] ve 4 misafir

cron
Bumerang - Yazarkafe