formülü makroya çevirme

[pylor]

sayın uzman arkadaşlar yapmak istediğim şey hakkında formda yaptığım arama sonucu benzer bir konu buldum ve inceledim ancak konuya çözüm yönünden bir cevap gelmediği için bana hiç yardımı olmadı o yüzden yeni konu açmak zorunda kaldım acaba ekteki dosyamda "data" ve "sayaç" sayfalarında kırmızı ile yazılmış olan eğer formüllerini makro ile yaptırmak mümkünmü bu şekilde olursa sayfamın biraz daha hızlanacagını düşünüyorum böyle bir şey olabilirmi yardımlarınız için teşekkürler

 

[mancubus]

aslında bir çok örneği var forumda.

ben DATA sayfası için vereyim. siz diğer sayfayı uyarlayın.

Dim ss As Long

ss = Cells(Rows.Count, 1).End(3).Row 'A SÜTUNUNA GÖRE SON SATIR NO

Range("F2:F" & ss) = "=IF(A2="""","""",A2&C2)"
Range("G2:G" & ss) = "=IF(E2="""","""",A2&C2)"
Range("H2:H" & ss) = "=""""&D2&""""&A2&""""&E2&"""""
Range("I2:I" & ss) = "=IF(H2=""DR. HALİT ÜNALGASTROSKOPİ"",""hü_g"",IF(H2=""DR. HALİT ÜNALGASTROSKOPİ1"",""hü_g+bx"",IF(H2=""DR. HALİT ÜNALKOLONOSKOPİ"",""hü_k"",IF(H2=""DR. HALİT ÜNALKOLONOSKOPİ1"",""hü_k+bx"",""""))))"
Range("J2:J" & ss) = "=IF(H2=""DR. SELİM AKÇAYGASTROSKOPİ"",""sa_g"",IF(H2=""DR. SELİM AKÇAYGASTROSKOPİ1"",""sa_g+bx"",IF(H2=""DR. SELİM AKÇAYKOLONOSKOPİ"",""sa_k"",IF(H2=""DR. SELİM AKÇAYKOLONOSKOPİ1"",""sa_k+bx"",""""))))"
Range("K2:K" & ss) = "=IF(H3=""DR. ATİLLA ÖZTÜRKGASTROSKOPİ"",""aö_g"",IF(H3=""DR. ATİLLA ÖZTÜRKGASTROSKOPİ1"",""aö_g+bx"",IF(H3=""DR. ATİLLA ÖZTÜRKKOLONOSKOPİ"",""aö_k"",IF(H3=""DR. ATİLLA ÖZTÜRKKOLONOSKOPİ1"",""aö_k+bx"",""""))))"

 

[halit3]

sayın uzman arkadaşlar yapmak istediğim şey hakkında formda yaptığım arama sonucu benzer bir konu buldum ve inceledim ancak konuya çözüm yönünden bir cevap gelmediği için bana hiç yardımı olmadı o yüzden yeni konu açmak zorunda kaldım acaba ekteki dosyamda "data" ve "sayaç" sayfalarında kırmızı ile yazılmış olan eğer formüllerini makro ile yaptırmak mümkünmü bu şekilde olursa sayfamın biraz daha hızlanacagını düşünüyorum böyle bir şey olabilirmi yardımlarınız için teşekkürler

Alternatif kod

Bu kodu data sayfasında çalıştırın.

Bu arada şunuda merak ediyorum bu dosyana daha öncede kod yazmıştım ama göremedim kodları.

Sub aktar()
Set sh2 = Sheets("DATA")
deg = 0
For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Name = "veri" Then
deg = 1
Exit For
End If
Next
If deg = 0 Then
Sheets.Add
Sheets(ActiveSheet.Name).Name = "veri"
Sheets("DATA").Select
End If
Set sh1 = Sheets("veri")
sh1.Range("A1:G5000").ClearContents
sh2.Columns("F:AZ").ClearContents
Son = sh2.Cells(Rows.Count, "d").End(xlUp).Row
sh2.Range("D1:D" & Son).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=sh2.Range("D1:D" & Son), CopyToRange:=sh1.Range("a1"), Unique:=True
 
For r = 2 To sh2.Cells(Rows.Count, "a").End(3).Row
sh2.Cells(r, 8).Value = sh2.Cells(r, 4).Value & sh2.Cells(r, 1).Value & sh2.Cells(r, 5).Value
If sh2.Cells(r, 2).Value <> "" Then
sh2.Cells(r, 6).Value = sh2.Cells(r, [COLOR=red]1[/COLOR]).Value & sh2.Cells(r, 3).Value
End If
If sh2.Cells(r, 5).Value <> "" Then
sh2.Cells(r, 7).Value = sh2.Cells(r, [COLOR=red]1[/COLOR]).Value & sh2.Cells(r, 3).Value
End If
sh2.Cells(r, 8).Value = sh2.Cells(r, 4).Value & sh2.Cells(r, 1).Value & sh2.Cells(r, 5).Value
Next r
 
sut = 9
For i = 2 To sh1.Cells(Rows.Count, "a").End(3).Row
bulunan1 = sh1.Cells(i, 1).Value
sh2.Cells(1, sut).Value = bulunan1
For r = 2 To sh2.Cells(Rows.Count, "a").End(3).Row
If bulunan1 = sh2.Cells(r, 4).Value Then
aranan1 = sh2.Cells(r, 1).Value
aranan2 = sh2.Cells(r, 5).Value
If aranan1 = "GASTROSKOPİ" Then
sh2.Cells(r, sut).Value = "sa_g"
ElseIf aranan1 & aranan2 = "GASTROSKOPİ1" Then
sh2.Cells(r, sut).Value = "sa_g+bx"
ElseIf aranan1 = "KOLONOSKOPİ" Then
sh2.Cells(r, sut).Value = "sa_k"
ElseIf aranan1 & aranan2 = "KOLONOSKOPİ1" Then
sh2.Cells(r, sut).Value = "sa_k+bx"
End If
End If
Next r
sut = sut + 1
Next i
Application.DisplayAlerts = False
Sheets("veri").Select
ActiveWindow.SelectedSheets.Delete
MsgBox "işlem tamam"
End Sub

 

[halit3]

Yukarıdaki koddaki kırmızı olan yerleri değiştirdim.

 

[pylor]

sayın mancubus ve sayın halit3 uğraşlarınız için çok teşekkür ederim elinize sağlık her iki kodlamada işe yaradı üzerinde çalışıp diğer formüllerimide bu şekilde kod yardımı ile yapmaya çalışacağım sayın halit3 sizin sorunuza gelince dosyama önceden eklemiş olduğunuz kodları bir müddet kullandım sorunum olmadı ancak ben sayfaya bazı eklentiler yaptım biraz daha detay için sizin kodları uyarlamaya çalıştım ama beceremedim formüllerle yaptım bu seferde dosya yavaşladı bende artık formül kullanmamaya karar verdim ve formülleri nasıl makrolara çevirebileceğim hakkında bilgi için aynı dosyam ile yeni bir konu açtım çokta yardımı oldu umarım diğer arkadaşlarada faydası olur ben yine size uğraşlarınız için çok çok teşekkür ederim bana çok faydanız oldu bi çok şey öğrendim sayenizde iyi geceler diliyorum size kolay gelsin

 

[onurcan1979]

CommandButton1 DE VERİ AKTARMASI YAPILA BİLİRMİ BN2:BN65536 İLE BO2:BO65536 HÜCRELERİNE İKİSİNEDE VERİ GİRİLDİĞİNDE CommandButton1 BUTONUNA TIKLAYINCA BP KADAR OLAN KAYITLARIN HEPSİNİ BAŞKA HÜCREYE AKTARIP MEVCUT HÜCREDEN SİLİNMESİNİ SAĞLAYABİLİRMİYİM BU KONUDA YADIM EDERSENİZ ÇOK SEVİNİRİM

 

[İhsan Tank]

CommandButton1 DE VERİ AKTARMASI YAPILA BİLİRMİ BN2:BN65536 İLE BO2:BO65536 HÜCRELERİNE İKİSİNEDE VERİ GİRİLDİĞİNDE CommandButton1 BUTONUNA TIKLAYINCA BP KADAR OLAN KAYITLARIN HEPSİNİ BAŞKA HÜCREYE AKTARIP MEVCUT HÜCREDEN SİLİNMESİNİ SAĞLAYABİLİRMİYİM BU KONUDA YADIM EDERSENİZ ÇOK SEVİNİRİM

öncelikle form kurallarına riayet ediniz büyük harf yazmayınız.
bir örnek dosya ekleyin ve şunları istiyorum diye belirtin.

 

[onurcan1979]

öncelikle form kurallarına riayet ediniz büyük harf yazmayınız.
bir örnek dosya ekleyin ve şunları istiyorum diye belirtin.

İlhan bey haklısınız dikkat etmem gerekirdi Form kurallarına bundan sonra daha dikkatli davranacağımdan emin olabilirsiniz.

istemiş olduğum yardım ektedir

 

[İhsan Tank]

sorunuzu bir kez daha okur musunuz.
siz kendinize anlatmışsınız projeyi bizim anlayacağımız şekilde anlatın
içinde veri yok bu veriler neye göre aktarılacak.
hepsi aktarılacaksa buna ne gerek var. tek sayfada işlem yapın dosyanız boşuna kasılmasın.

lütfen daha detaylı bilgi veriniz ve içine veri girerek şu olduğunda aktarsın şu olduğunda aktarmasın gibi