Soru Makro hatası

mor45 · 7 Eylül 2018

Dosyamın içindeki sağlık sayfasındaki mavi olan radyolojide çalışan persaneller seç butonuna tıkladımda makro çalaşmıyor.
Personel sayfasına bakar eksik hüçreleri tamamlamalı, ama 20 satırdan sonraları yazmıyor lütfen yardım edin.
Sub radyoloji_aktar_saglik()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi
Set bordo = Sheets("PERSONEL ")
Set mavi = Sheets("SAĞLIK")
trabzonspor = MsgBox("Aktarıma Başlıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
For ts = 3 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
bordo.Cells(ts, "K") = Right(bordo.Cells(ts, "A"), Len(bordo.Cells(ts, "A")) - WorksheetFunction _
.Find("*", WorksheetFunction.Substitute(bordo.Cells(ts, "A"), " ", "*", Len(bordo.Cells(ts, "A")) _
- Len(WorksheetFunction.Substitute(bordo.Cells(ts, "A"), " ", "")))))
bordo.Cells(ts, "L") = Len(bordo.Cells(ts, "A")) - Len(bordo.Cells(ts, "K"))
bordo.Cells(ts, "J") = Mid(bordo.Cells(ts, "A"), 1, bordo.Cells(ts, "L") - 1)
Next
mavi.Range("B4

" & Rows.Count).ClearContents
trabzonspor = 4
Set ts = bordo.Range("G:G").Find("SAĞLIK", , , xlWhole)
If Not ts Is Nothing Then
kaplan = ts.Address
Do
mavi.Cells(trabzonspor, "C") = bordo.Cells(ts.Row, "J")
mavi.Cells(trabzonspor, "D") = bordo.Cells(ts.Row, "K")
trabzonspor = trabzonspor + 1
Set ts = bordo.Range("G:G").FindNext(ts)
Loop While Not ts Is Nothing And ts.Address <> kaplan
End If
mavi.Range("B4") = 1
mavi.Range("B4:B" & trabzonspor - 1).DataSeries rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
step:=1, Trend:=False
bordo.Range("J:L").ClearContents
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Aktarım Tamamlandı", , "Bitiş"

dosyayı atacak yeri bulamadım. yardım

turist · 7 Eylül 2018

For ts = 3 To bordo.Cells(Rows.Count, "A").End(xlUp).Row

satırında yer alan Rows.Count, "A"
ilk sütun , yani A sütunundaki son dolu satıra kadar olan değeri bulur.
Eğer arama yaptığınız sütun A değil örneğin "K" ise
bu durumda
For ts = 3 To bordo.Cells(Rows.Count, "K").End(xlUp).Row
yazmalısınız.

mor45 · 7 Eylül 2018

turist' Alıntı:
For ts = 3 To bordo.Cells(Rows.Count, "A").End(xlUp).Row

satırında yer alan Rows.Count, "A"
ilk sütun , yani A sütunundaki son dolu satıra kadar olan değeri bulur.
Eğer arama yaptığınız sütun A değil örneğin "K" ise
bu durumda
For ts = 3 To bordo.Cells(Rows.Count, "K").End(xlUp).Row
yazmalısınız.

https://www.dosyaupload.com/qFh0 dosya bu adreste bakarsanız sevinirim

mor45 · 7 Eylül 2018

Biraz daha dikkatli bakınca anladım. Yalnız C sütununa ad ve soy adı bitişik getiriyor Adı C sütununa D sütununa da Soyadı getirmiyor.

halit3 · 7 Eylül 2018

Bu dosyanızda ad ve soyad ayırımı mı yapmak istiyorsunuz.

turist · 7 Eylül 2018

Bu makro kodu (yanlış şekilde) sadece Ad soyad getiriyor.
Kodların yapısı yanlış yeniden düzenlenmesi gerekir.

mor45 · 7 Eylül 2018

halit3' Alıntı:
Bu dosyanızda ad ve soyad ayırımı mı yapmak istiyorsunuz.

Evet ad ve soyadı ayrı yazdırmasını istiyorum.

halit3 · 7 Eylül 2018

Bu kodu kullan

PHP:

Sub ayir1()

sut1 = 2
For r = 3 To Sheets("PERSONEL ").Cells(Rows.Count, "a").End(3).Row
Sheets("PERSONEL ").Cells(r, 1).Value = WorksheetFunction.Trim(Sheets("PERSONEL ").Cells(r, 1).Value)
son = ""

say1 = ""
say2 = ""

deg = Split(WorksheetFunction.Trim(Sheets("PERSONEL ").Cells(r, 1).Value), " ")

If UBound(deg) > 0 Then
son = UBound(deg) - 1
End If

'Sheets("SAĞLIK").Cells(r + 1, sut1).Value = son
If son = "" Then
If Sheets("PERSONEL ").Cells(r, "A") <> "" Then
say1 = deg(0)
End If
ElseIf son = 0 Then
say1 = deg(0)
say2 = deg(1)
ElseIf son = 1 Then
say1 = deg(0)
say2 = deg(1) & " " & deg(2)

ElseIf son = 2 Then
say1 = deg(0) & " " & deg(1)
say2 = deg(2) & " " & deg(3)
ElseIf son > 2 Then
say1 = "İkiden fazla isim var"
say2 = "İkiden fazla soy isim var"

End If

Sheets("SAĞLIK").Cells(r + 1, sut1 + 1).Value = say1
Sheets("SAĞLIK").Cells(r + 1, sut1 + 2).Value = say2

Next

End Sub

turist · 7 Eylül 2018

Makro dışında Formüllerdeki hatanın da düzeltilmesi gerekir.
Örnek:
"SAĞLIK" sayfasında E4 hücresindeki formül:
=EĞER(C4="";"";(düşeyara(SAĞLIK!C4&" "&SAĞLIK!D4;'PERSONEL '!$A$3:$H$70;2;0)))
şeklinde, bunun
=EĞER(C4="";"";(DÜŞEYARA(SAĞLIK!C4&" "&SAĞLIK!D4;'PERSONEL '!$A$3:$H$1000;2;0)))
gibi düzeltimesi ve aynı düzeltmein F4, G4 ve H4 de de yapılması geriyor.
Daha sonra bu hücrelerin en alt satırlara kadar kopyalanıp yapıştırılması gerekiyor.

turist · 7 Eylül 2018

Ayrıca;
L4 hücresinde ki formül:
=EĞER(B4>0;DÜŞEYARA(E4;'MAAŞ Normal'!C$3:I$33;5;FALSE);"")
formülünün de
=EĞER(B4>0;DÜŞEYARA(E4;'MAAŞ Normal'!C$3:I$1000;5;FALSE);"")
şeklinde revize edilmesi gerekir.

mor45 · 7 Eylül 2018

turist' Alıntı:
Ayrıca;
L4 hücresinde ki formül:
=EĞER(B4>0;DÜŞEYARA(E4;'MAAŞ Normal'!C$3:I$33;5;FALSE);"")
formülünün de
=EĞER(B4>0;DÜŞEYARA(E4;'MAAŞ Normal'!C$3:I$1000;5;FALSE);"")
şeklinde revize edilmesi gerekir.

Ok çok teşekkürler

turist · 7 Eylül 2018

Sayın @halit3'ün makrosu uygulandığında ise;
yukarıdaki formül düzeltmeleri ve ayrıca;
B4 hücresine:
=SATIR()-3
formülünü yazıp, kopyalayıp en alttaki satıra kadar yapıştırılması da gerekecektir.
Ya da bunların hepsi ayrıca tek bir makro kodu ile çözümlenebilecektir.
Tercih sizin...
İyi çalışmalar.

halit3 · 8 Eylül 2018

Sağlık sayfasında R3 hücresine pirim ödeme gün sayısını 30 olarak yazınız.
bu kodu çalıştırın.

PHP:

Sub ayir2()


With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

Sheets("SAĞLIK").Range("B4:N250").ClearContents

For r = 3 To Sheets("PERSONEL ").Cells(Rows.Count, "a").End(3).Row

son = ""
say1 = ""
say2 = ""

deg = Split(WorksheetFunction.Trim(Sheets("PERSONEL ").Cells(r, 1).Value), " ")

If UBound(deg) > 0 Then
son = UBound(deg) - 1
End If

If son = "" Then
If Sheets("PERSONEL ").Cells(r, "A") <> "" Then
say1 = deg(0)
End If
ElseIf son = 0 Then
say1 = deg(0)
say2 = deg(1)
ElseIf son = 1 Then
say1 = deg(0)
say2 = deg(1) & " " & deg(2)

ElseIf son = 2 Then
say1 = deg(0) & " " & deg(1)
say2 = deg(2) & " " & deg(3)
ElseIf son > 2 Then
say1 = "İkiden fazla isim var"
say2 = "İkiden fazla soy isim var"

End If

Sheets("SAĞLIK").Cells(r + 1, 2).Value = r - 2

Sheets("SAĞLIK").Cells(r + 1, 3).Value = say1
Sheets("SAĞLIK").Cells(r + 1, 4).Value = say2
Sheets("SAĞLIK").Cells(r + 1, 5).Value = Sheets("PERSONEL ").Cells(r, 2).Value
Sheets("SAĞLIK").Cells(r + 1, 6).Value = Sheets("PERSONEL ").Cells(r, 3).Value

Sheets("SAĞLIK").Cells(r + 1, 7).Value = Sheets("PERSONEL ").Cells(r, 4).Value
Sheets("SAĞLIK").Cells(r + 1, 8).Value = Sheets("PERSONEL ").Cells(r, 5).Value

Sheets("SAĞLIK").Cells(r + 1, 9).Value = Sheets("PERSONEL ").Cells(r, 8).Value
Sheets("SAĞLIK").Cells(r + 1, 12).Value = Sheets("MAAŞ Normal").Cells(r, 7).Value

Sheets("SAĞLIK").Cells(r + 1, 11).Value = Sheets("SAĞLIK").Cells(7, 19).Value

Sheets("SAĞLIK").Cells(r + 1, 13).Value = WorksheetFunction.RoundUp((Sheets("SAĞLIK").Cells(r + 1, 11).Value / 8), 0)

pirim = Sheets("SAĞLIK").Cells(3, 18).Value


Sheets("SAĞLIK").Cells(r + 1, 14).Value = WorksheetFunction.Round(((Sheets("SAĞLIK").Cells(r + 1, 13).Value * 5) / pirim), 2)
Sheets("SAĞLIK").Cells(r + 1, 10).Value = pirim


Next


With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With

MsgBox "işlem tamam"
End Sub

mor45 · 8 Eylül 2018

halit3' Alıntı:

Sağlık sayfasında R3 hücresine pirim ödeme gün sayısını 30 olarak yazınız.
bu kodu çalıştırın.

PHP:

Sub ayir2()


With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

Sheets("SAĞLIK").Range("B4:N250").ClearContents

For r = 3 To Sheets("PERSONEL ").Cells(Rows.Count, "a").End(3).Row

son = ""
say1 = ""
say2 = ""

deg = Split(WorksheetFunction.Trim(Sheets("PERSONEL ").Cells(r, 1).Value), " ")

If UBound(deg) > 0 Then
son = UBound(deg) - 1
End If

If son = "" Then
If Sheets("PERSONEL ").Cells(r, "A") <> "" Then
say1 = deg(0)
End If
ElseIf son = 0 Then
say1 = deg(0)
say2 = deg(1)
ElseIf son = 1 Then
say1 = deg(0)
say2 = deg(1) & " " & deg(2)

ElseIf son = 2 Then
say1 = deg(0) & " " & deg(1)
say2 = deg(2) & " " & deg(3)
ElseIf son > 2 Then
say1 = "İkiden fazla isim var"
say2 = "İkiden fazla soy isim var"

End If

Sheets("SAĞLIK").Cells(r + 1, 2).Value = r - 2

Sheets("SAĞLIK").Cells(r + 1, 3).Value = say1
Sheets("SAĞLIK").Cells(r + 1, 4).Value = say2
Sheets("SAĞLIK").Cells(r + 1, 5).Value = Sheets("PERSONEL ").Cells(r, 2).Value
Sheets("SAĞLIK").Cells(r + 1, 6).Value = Sheets("PERSONEL ").Cells(r, 3).Value

Sheets("SAĞLIK").Cells(r + 1, 7).Value = Sheets("PERSONEL ").Cells(r, 4).Value
Sheets("SAĞLIK").Cells(r + 1, 8).Value = Sheets("PERSONEL ").Cells(r, 5).Value

Sheets("SAĞLIK").Cells(r + 1, 9).Value = Sheets("PERSONEL ").Cells(r, 8).Value
Sheets("SAĞLIK").Cells(r + 1, 12).Value = Sheets("MAAŞ Normal").Cells(r, 7).Value

Sheets("SAĞLIK").Cells(r + 1, 11).Value = Sheets("SAĞLIK").Cells(7, 19).Value

Sheets("SAĞLIK").Cells(r + 1, 13).Value = WorksheetFunction.RoundUp((Sheets("SAĞLIK").Cells(r + 1, 11).Value / 8), 0)

pirim = Sheets("SAĞLIK").Cells(3, 18).Value


Sheets("SAĞLIK").Cells(r + 1, 14).Value = WorksheetFunction.Round(((Sheets("SAĞLIK").Cells(r + 1, 13).Value * 5) / pirim), 2)
Sheets("SAĞLIK").Cells(r + 1, 10).Value = pirim


Next


With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With

MsgBox "işlem tamam"
End Sub

SAĞLIK sayfasında personel sayfasından verileri alırken G hücresindeki yalnızca sağlık görevlileri çekmecek.
Radyoloji ve boş olan kişileri getirmiyecek. Oysa bütün personel geliyor.

Sağlık sayfasında
k5 hücresi EĞER(B4="";"";(EĞER(S$7<168;S$7;168))) ile S$7 hücre kaç olursa olsun 168 geçmiyecek yekilde k5 hücresine yazmalı
M4 hücerei EĞER(B4="";"";(YUKARIYUVARLA((K4/8);0))) ile K4 hcresi 8 bölünmeli ve yukarı yuvarlamalı
N4 hücresi EĞER(B4="";"";(YUVARLA(M4*5/30;2))) ile M4 teki sayı 5 ile çarpılıp 30 bölünecek fiili hizmet zami süresi 0,00 sayısal
değer getirmeli.

Kusura bakmayın biraz çok yazım yardımcı olursanız sevinirim. Çoook teşekkürler
Ayır2() ollan makrodaki eksiklik

halit3 · 8 Eylül 2018

personel sayfasında G sutünunda SAĞLIK yazanları aktarıyor.
Sağlık sayfasında R3 hücresine pirim ödeme gün sayısını 30 olarak yazınız.

kod

PHP:

Sub aktar2()


With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

Sheets("SAĞLIK").Range("B4:N250").ClearContents

aranan = "SAĞLIK"

sat = 4
For r = 3 To Sheets("PERSONEL ").Cells(Rows.Count, "a").End(3).Row

If Sheets("PERSONEL ").Cells(r, 7).Value = aranan Then

son = ""
say1 = ""
say2 = ""
deg = Split(WorksheetFunction.Trim(Sheets("PERSONEL ").Cells(r, 1).Value), " ")

If UBound(deg) > 0 Then
son = UBound(deg) - 1
End If

If son = "" Then
If Sheets("PERSONEL ").Cells(r, "A") <> "" Then
say1 = deg(0)
End If
ElseIf son = 0 Then
say1 = deg(0)
say2 = deg(1)
ElseIf son = 1 Then
say1 = deg(0)
say2 = deg(1) & " " & deg(2)

ElseIf son = 2 Then
say1 = deg(0) & " " & deg(1)
say2 = deg(2) & " " & deg(3)
ElseIf son > 2 Then
say1 = "İkiden fazla isim var"
say2 = "İkiden fazla soy isim var"
End If


Sheets("SAĞLIK").Cells(sat, 2).Value = r - 2
Sheets("SAĞLIK").Cells(sat, 3).Value = say1
Sheets("SAĞLIK").Cells(sat, 4).Value = say2
Sheets("SAĞLIK").Cells(sat, 5).Value = Sheets("PERSONEL ").Cells(r, 2).Value
Sheets("SAĞLIK").Cells(sat, 6).Value = Sheets("PERSONEL ").Cells(r, 3).Value
Sheets("SAĞLIK").Cells(sat, 7).Value = Sheets("PERSONEL ").Cells(r, 4).Value
Sheets("SAĞLIK").Cells(sat, 8).Value = Sheets("PERSONEL ").Cells(r, 5).Value
Sheets("SAĞLIK").Cells(sat, 9).Value = Sheets("PERSONEL ").Cells(r, 8).Value

If Sheets("SAĞLIK").Cells(7, 19).Value < 168 Then
Sheets("SAĞLIK").Cells(sat, 11).Value = Sheets("SAĞLIK").Cells(7, 19).Value
Else
Sheets("SAĞLIK").Cells(sat, 11).Value = 168
End If

Sheets("SAĞLIK").Cells(sat, 12).Value = Sheets("MAAŞ Normal").Cells(r, 7).Value
Sheets("SAĞLIK").Cells(sat, 13).Value = WorksheetFunction.RoundUp((Sheets("SAĞLIK").Cells(sat, 11).Value / 8), 0)

pirim = Sheets("SAĞLIK").Cells(3, 18).Value

Sheets("SAĞLIK").Cells(sat, 14).Value = WorksheetFunction.Round(((Sheets("SAĞLIK").Cells(sat, 13).Value * 5) / pirim), 2)
Sheets("SAĞLIK").Cells(sat, 10).Value = pirim
sat = sat + 1
End If

Next

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With

MsgBox "işlem tamam"
End Sub

mor45 · 9 Eylül 2018

halit3' Alıntı:

personel sayfasında G sutünunda SAĞLIK yazanları aktarıyor.
Sağlık sayfasında R3 hücresine pirim ödeme gün sayısını 30 olarak yazınız.

kod

PHP:

Sub aktar2()


With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

Sheets("SAĞLIK").Range("B4:N250").ClearContents

aranan = "SAĞLIK"

sat = 4
For r = 3 To Sheets("PERSONEL ").Cells(Rows.Count, "a").End(3).Row

If Sheets("PERSONEL ").Cells(r, 7).Value = aranan Then

son = ""
say1 = ""
say2 = ""
deg = Split(WorksheetFunction.Trim(Sheets("PERSONEL ").Cells(r, 1).Value), " ")

If UBound(deg) > 0 Then
son = UBound(deg) - 1
End If

If son = "" Then
If Sheets("PERSONEL ").Cells(r, "A") <> "" Then
say1 = deg(0)
End If
ElseIf son = 0 Then
say1 = deg(0)
say2 = deg(1)
ElseIf son = 1 Then
say1 = deg(0)
say2 = deg(1) & " " & deg(2)

ElseIf son = 2 Then
say1 = deg(0) & " " & deg(1)
say2 = deg(2) & " " & deg(3)
ElseIf son > 2 Then
say1 = "İkiden fazla isim var"
say2 = "İkiden fazla soy isim var"
End If


Sheets("SAĞLIK").Cells(sat, 2).Value = r - 2
Sheets("SAĞLIK").Cells(sat, 3).Value = say1
Sheets("SAĞLIK").Cells(sat, 4).Value = say2
Sheets("SAĞLIK").Cells(sat, 5).Value = Sheets("PERSONEL ").Cells(r, 2).Value
Sheets("SAĞLIK").Cells(sat, 6).Value = Sheets("PERSONEL ").Cells(r, 3).Value
Sheets("SAĞLIK").Cells(sat, 7).Value = Sheets("PERSONEL ").Cells(r, 4).Value
Sheets("SAĞLIK").Cells(sat, 8).Value = Sheets("PERSONEL ").Cells(r, 5).Value
Sheets("SAĞLIK").Cells(sat, 9).Value = Sheets("PERSONEL ").Cells(r, 8).Value

If Sheets("SAĞLIK").Cells(7, 19).Value < 168 Then
Sheets("SAĞLIK").Cells(sat, 11).Value = Sheets("SAĞLIK").Cells(7, 19).Value
Else
Sheets("SAĞLIK").Cells(sat, 11).Value = 168
End If

Sheets("SAĞLIK").Cells(sat, 12).Value = Sheets("MAAŞ Normal").Cells(r, 7).Value
Sheets("SAĞLIK").Cells(sat, 13).Value = WorksheetFunction.RoundUp((Sheets("SAĞLIK").Cells(sat, 11).Value / 8), 0)

pirim = Sheets("SAĞLIK").Cells(3, 18).Value

Sheets("SAĞLIK").Cells(sat, 14).Value = WorksheetFunction.Round(((Sheets("SAĞLIK").Cells(sat, 13).Value * 5) / pirim), 2)
Sheets("SAĞLIK").Cells(sat, 10).Value = pirim
sat = sat + 1
End If

Next

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With

MsgBox "işlem tamam"
End Sub

Sağlık sayfası tamam

TABLO 13 TE
121 satırdan sonra değerler bitiyor sıra no olan A sütunu ve Çalışılan Gün olan G sütunları boş olarak nasıl getirebilirim.

halit3 · 9 Eylül 2018

Sizin göndermiş olduğunuz dosyada TOBLO 13 sayfasında 28 satırda veriler bitiyor

mor45 · 9 Eylül 2018

halit3' Alıntı:
Sizin göndermiş olduğunuz dosyada TOBLO 13 sayfasında 28 satırda veriler bitiyor

121 satıra kadar değer girdim bundan sonra değer yok
Yeni değerler girdim dosya ekte
https://www.dosyaupload.com/e53e

halit3 · 9 Eylül 2018

Kaç satır olması lazım

mor45 · 9 Eylül 2018

halit3' Alıntı:
Kaç satır olması lazım

şuan 150 personel olacak ileride çoğaltılabilecek

Soru Makro hatası

mor45

turist

Destek Ekibi

mor45

mor45

halit3

Uzman

turist

Destek Ekibi

mor45

halit3

Uzman

turist

Destek Ekibi

turist

Destek Ekibi

mor45

turist

Destek Ekibi

halit3

Uzman

mor45

halit3

Uzman

mor45

halit3

Uzman

mor45

halit3

Uzman

mor45