1 sayfadan 1. sayfa

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

İletiTarih: 10 Ekm 2018 19:12
yesim_gurol
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]

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

İletiTarih: 10 Ekm 2018 21:14
askmadige34
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

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

İletiTarih: 10 Ekm 2018 21:21
Enes Recep BAĞ
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

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

İletiTarih: 11 Ekm 2018 07:36
yesim_gurol
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:

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

İletiTarih: 11 Ekm 2018 07:39
yesim_gurol
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)