sendkeys {f2}+{enter} çalıştırmak veya alternatif yol

[netkit]

iyi akşamlar;
ekteki "senetodeme.xls" tablosundan (sql den alınan) ödenen senetleri verilmiş "excelsenet.xls" tablosuna işliyorum. Makro ile işlemeyi hızlandırdım fakat virgüllü senetlerde F2+enter yaptıramadığımdan sayı olarak görmüyor. makro çalıştıktan sonra h47 deki satırı f2+enter veya başka şekilde nasıl sayı olarak gösterebilirim?


not:bu sitede emeği geçen herkese teşükkür ederim bu noktaya kadar gelebilmemde yardımcı oldukları için.

 

[mancubus]

metin olarak saklanan rakamları rakama dönüştürmek için ilgili rakamların bulunduğu alan belirtilerek aşağıdaki kod kullanılabilir.

Sub rakama_cevir() 

    With Range("H2:H500")
        .NumberFormat = "General"
        .Value = .Value
    End With

End Sub

 

[netkit]

Sayın mancubus;
cevap için teşekkür ederim.denedim fakat olmadı.

resimdeki gibi kalıyor h47. dolayısıyla diğer küsüratlı senetlerde böyle kalıyor tektek bulup F2+Enter yapınca düzeliyor. Bunu otomatik yapmak istiyorum.

 

[netkit]

...........

 

[mancubus]

bende çalışıyor. yıllardır kulandığım kod zaten.

eklenen dosyada böyle bir veri olmadığı için test edemiyorum.

böyle 3-5 verisi olan sade bir dosya ekleyebilir misin.

 

[netkit]

Sayın mancubus

ilk mesajda ki rar ın içnde 2 adet dosya mevcut. "excelsenet" in içindeki bulyaz makrosunu çalıştırınca h47 deki soruna çözüm arıyorum.

 

[mancubus]

kod bende çalışmadı.

ne işe yaradığını da anlayamadım. nerede ise bütün değişkenler string "metin" olarak tanımlanmış.

ben yardımcı olamayacağım. belki yardımcı olan çıkar diye buraya ekleyeyim.

Option Explicit
Sub bulyaz()
Dim sat As String
Dim senet As String
Dim cha_tarihi As String
Dim z As String
Dim X As String
Dim y As String
Dim s As Integer
Dim cha_meblag As String
'Dim LResult As String
Dim a As Variant
Dim zat As Date

sat = Cells(65536, "A").End(xlUp).Row
For s = 3 To sat
'LResult = Right(Cells(s, 7), 2)
senet = Cells(s, 6)
cha_tarihi = Cells(s, 1)
cha_meblag = Cells(s, 7) ' - LResult
Cells(s, 7).Select

Windows("excelsenet.xls").Activate
Set a = Sheets(1).Range("E:E").Find(senet, , xlValues, xlWhole)
zat = a.Offset(0, -1).Value
a.Offset(0, -1).Select
If zat = Empty Then
a.Offset(0, -1).Value = cha_tarihi
a.Offset(0, 3).Value = "+" & cha_meblag
a.Offset(0, 3).Select

'Application.SendKeys "{F2}"
'Application.SendKeys "{ENTER}"

Else
X = a.Offset(0, -1).Value
y = a.Offset(0, 3).Value
a.Offset(0, -1).Value = "'" & X & "/" + cha_tarihi
a.Offset(0, 3).Value = "+" & y & "+" & cha_meblag
If Left(a.Offset(0, 3), 1) = "+" Then
'a.Offset(0, 3).Value = "=" + a.Offset(0, 3).Value
a.Offset(0, 3).Select
a.Offset(0, 3).Value = "=" & a.Offset(0, 3).Value
'Application.SendKeys "{f2}", True
'Application.SendKeys "{ENTER}", True
End If
End If
Windows("SENET ÖDEME.xls").Activate
Next
End Sub

Sub HÜCRE_YENİLE()
    Dim X As Long
    For X = 47 To 48 'Rows.Count
    DoEvents
        Cells(X, "H").Select
        SendKeys "{F2}", True
     SendKeys "{ENTER}", True
    Next
End Sub

Sub F2_ENTER()
[H47].Select
Application.SendKeys "{F2}"
Application.SendKeys "{ENTER}"
End Sub

 

[mancubus]

not: bir makronun ismi F2_ENTER.

hücre adresi olarak yorumlanacak (F2) veya excel'e tahsis edilmiş "enter" olayı gibi şeyleri makro ismi olarak kullanmamak yerinde olur.

 

[netkit]

Sayın mancubus;

uğraşınız için teşekkür ederim.
kod kısaca senet ödeme tablosundaki referans nosunu excelsenet tablosunda bulup ödeme tarihini ve ödenen tutarı yazıyor. Fakat parçalı ödeme yapıldığı için her tarih için / şeklinde devam edip hangi tarihte ne kadar ödenmişi + yaparak takip etmek istiyorum. Sadece toplam ödenmiş olsa yapabliyorum ama küsüratlı ödemede malesef hücrede toplam aldıramadım.
örneğin ilk senet için 01.09.2012 de 50 daha sonra 05.09.2012 de 50 tl ödenmiş ise
tarih bölümünde
01.09.2012/05.09.2012 ödenen bölümünde =50+50 olarak görmem lazım.

Makroyu adımlayarak daha rahat izleyebilirsiniz..
ilginize teşekkür ederim. bir yol bulana kadar elle düzeltmeye devam..

not: son 2 makro siteden alıntı.fakat adımlayarak yaptım bende çalışmadı yada benim düşündüğüm işe yaramıyor.

 

[mancubus]

kodlar bana şüpheli geldi. ancak yoğun olduğumdan detaylı inceleme imkanım yok.
eğer iş görüyorsa ve tek ihtiyaç ta F2 ve ENTER ise bir de şu denenebilir.

Sub rakama_cevir_aralik()
    
    Dim cll As Range
    
    For Each cll In Range("H2:H250")
        If Len(cll) Then 'boş hücrelerde işlem yapmaması için koşul
            cll.Value = CDbl(cll.Value)
            cll.NumberFormat = "#"
        End If
    Next

End Sub

Sub rakama_cevir_bir_hucre()
    
    If Len(Range("H47")) Then
        Range("H47").Value = CDbl(Range("H47").Value)
        Range("H47").NumberFormat = "#"
    End If

End Sub

 

[ExcelF1]

"bulyaz" makronuza, aşağıda kırmızı renkle belirtilen bölümü ekleyerek deneyiniz.
NOT = "F2_ENTER" makronuz sadece H47 hücresinde işlem yapacaktır. Başka bir hücrede benzer bir problem ile karşılaştığınızda bu kod doğru işlemi yürütmeyecektir. Doğru işlemi yürütebilmesi için F2_ENTER makronuzda, hücre içine girip çıkma olayını döngüye almanızı tavsiye ederim.


Sub bulyaz()
Dim sat As String
Dim senet As String
Dim cha_tarihi As String
Dim z As String
Dim X As String
Dim y As String
Dim s As Integer
Dim cha_meblag As String
Dim a As Variant
Dim zat As Date
sat = Cells(65536, "A").End(xlUp).Row
For s = 3 To sat
senet = Cells(s, 6)
cha_tarihi = Cells(s, 1)
cha_meblag = Cells(s, 7)
Cells(s, 7).Select
Windows("excelsenet.xls").Activate
Set a = Sheets(1).Range("E:E").Find(senet, , xlValues, xlWhole)
zat = a.Offset(0, -1).Value
a.Offset(0, -1).Select
If zat = Empty Then
a.Offset(0, -1).Value = cha_tarihi
a.Offset(0, 3).Value = "+" & cha_meblag
a.Offset(0, 3).Select
Else
X = a.Offset(0, -1).Value
y = a.Offset(0, 3).Value
a.Offset(0, -1).Value = "'" & X & "/" + cha_tarihi
a.Offset(0, 3).Value = "+" & y & "+" & cha_meblag
If Left(a.Offset(0, 3), 1) = "+" Then
a.Offset(0, 3).Select
a.Offset(0, 3).Value = "=" & a.Offset(0, 3).Value
End If
End If
Windows("SENET ÖDEME.xls").Activate
Next
Windows("excelsenet.xls").Activate
F2_ENTER
End Sub

 

[netkit]

Sayın mancubus

elinize sağlık.Bende akşam uğraştım "+" kullanınca oluyor "=" deyince malesef olmuyordu sabah sizin kodları denedim oldu.. sağolun.

Sayın ExcelF1 malesef eklemeyi yapsamda değişiklik olmadı. F2 enter ne yaptımsa işe yaramadı.

 

[netkit]

malesef tek rakam varsa +359,20 gibi oluyor ama +400+359,20 gibi olunca olmuyor..

a.Offset(0, 3).Value = "=" & a.Offset(0, 3).Value satırında run time error 13 type mismatch hatası verip kalıyor...

 

[netkit]

"=" yerine "&" işareti koyup daha sonra bul değiştirde "&" leri "=" yaparak geçici çözdüm belki başkasına lazım olur.

'Option Explicit
Sub bulyaz()
Dim sat As String
Dim senet As String
Dim cha_tarihi As String
Dim z As String
Dim X As String
Dim y As String
Dim s As Integer
Dim cha_meblag As String
'Dim LResult As String
Dim a As Variant
Dim zat As Variant

sat = Cells(65536, "A").End(xlUp).Row
For s = 2 To 40 'sat
'LResult = Right(Cells(s, 7), 2)
senet = Cells(s, 6)
cha_tarihi = Cells(s, 1)
cha_meblag = Cells(s, 7) ' - LResult
Cells(s, 7).Select

Windows("CELIK TEKNE VERİLEN SENET HAZİRAN 2012.xls").Activate
Set a = Sheets(1).Range("E:E").Find(senet, , xlValues, xlWhole)
a.Offset(0, -1).Select
zat = ActiveCell.Value

If zat = Empty Then
a.Offset(0, -1).Value = cha_tarihi
a.Offset(0, 3).Value = "+" & cha_meblag
a.Offset(0, 3).Select

Else
X = a.Offset(0, -1).Value
y = a.Offset(0, 3).Value
a.Offset(0, -1).Value = X & "/" + cha_tarihi
a.Offset(0, 3).Value = "+" & y & "+" & cha_meblag
If Left(a.Offset(0, 3), 1) = "+" Or Left(a.Offset(0, 3), 1) = "=" Then

a.Offset(0, 3).Select
a.Offset(0, 3).Value = "&" & a.Offset(0, 3).Value ' = yerine & kullandım

End If
End If
Windows("SENET ÖDEME.xls").Activate
Next

End Sub

 

[mancubus]

Option Explicit

Sub bul_yaz()

Dim wb1 As Workbook, wb2 As Workbook
Dim sat As Long, s As Long, senet As String
Dim cha_tarihi As Date, cha_meblag As Double
Dim a As Range, cll As Range, zat

Set wb1 = Workbooks("SENET ÖDEME.xls")
Set wb2 = Workbooks("excelsenet.xls")

wb2.Worksheets(1).Range("D2:D25000").Clear
wb2.Worksheets(1).Range("H2:H25000").Clear

With wb1.Worksheets("SENET ÖDEME")
    sat = .Cells(.Rows.Count, "A").End(xlUp).Row
    For s = 2 To sat
        senet = .Cells(s, 6)
        cha_tarihi = .Cells(s, 1)
        cha_meblag = .Cells(s, 7)
        Set a = wb2.Worksheets(1).Range("E:E").Find(senet, , xlValues, xlWhole)
        With a
            zat = .Offset(0, -1).Value
            If Len(Trim(zat)) = 0 Then
                .Offset(0, -1).Value = "'" & Format(cha_tarihi, "dd.mm.yyyy")
                .Offset(0, 3).Value = "'=" & cha_meblag
            Else
                .Offset(0, -1).Value = .Offset(0, -1).Value & "/" & Format(cha_tarihi, "dd.mm.yyyy")
                .Offset(0, 3).Value = .Offset(0, 3).Value & "+" & cha_meblag
            End If
        End With
    Next
End With

For Each cll In wb2.Worksheets(1).Range("H2:H25000")
    With cll
        If Len(.Value) > 0 Then
            If Not IsNumeric(.Value) Then
                If Left(.Value, 1) = "=" Then
                    .Value = Right(.Value, Len(.Value) - 1)
                    .Value = CDbl(.Value)
                End If
            End If
        End If
    End With
Next

End Sub

 

[netkit]

Sayın mancubus;
elinize sağlık. Gönderdiğim tabloda ilk ödemeler olmadığından yanıltıcı olmuş. makro eğer senetde daha önce ödeme varsa sayı haline dönüştüremiyor. vaktiniz olursa diye orijinal dosyayı tekrar gönderiyorum. ilginize ve paylaşımlarınız için teşekkür ediyorum. Kodlarınızdan çok bilgi edindim kod kısaltma ve mantık olarak.

 

[mancubus]

fırsat bulursam bakarım.


I sütununda her döviz cinsi için ayrı formül yerine ortak tek bir formül kullanırdım.

=IF(TRIM(J2)="Türk Lirası";G2-H2;IF(TRIM(J2)="Amerikan Doları";(G2-H2)*$N$1;IF(TRIM(J2)="Euro";(G2-H2)*$M$1;"Yanlış Döviz")))

döviz kodları (J sütunu) fazladan boşluk karakteri içerdiği için trim (KIRP) fonksiyonu ile temizledik.
tanım 3 döviz dışında bir döviz bilgisi girilmesi halinde hata mesajı verdirdik.
tabii ileride başka dövizler de eklenecekse bu defa formülün düzeltilmesi lazım.