Macro, vb. öğrenme (ivedi)

K

kodex

Katılım
27 Ağustos 2009
Mesajlar
2
Excel Vers. ve Dili
2007 TÜRKÇE
Merhaba arkadaşlar.

Aşağıda ko pyala/yapıştır yaptığım makro kodları var...

Bu kodları sıfırdan öğrenebileceğim Ankara'da herhangi bir kurs ya da önerebileceğiniz bir kitap var mı?

Bir kaç kurs soruşturdum ama onlar da çok bazit düzeyde anlatıyorlar. hatta bi kursa deneme amacıyla gittim. öğretmene düşeyara formülünü ben gösterdim :)

İşim gereği bu kodları kullanıyoruz ve kodlar yardımı ile bilgileri kısa sürede excell ortamında derleyip toparlayabiliyoruz. ama bu kodları biz değil de başkaları yazmış oluyor ve biz de kodları kalıp halinde kullandığımız için geliştiremiyoruz.


Sub XXXX()
Set müşteri = Worksheets("XXXX")
Worksheets("XXXX").Select
Range("B4:AC65536").Select
Selection.ClearContents
Worksheets("XXXX").Select

Dim AvivaApp As Object
Dim sessions As Object
Dim sess As Object
Dim appwin As Object
Dim data As String

Set AvivaApp = CreateObject("aviva.application")
Set sessions = AvivaApp.sessions
Set sess = AvivaApp.sessions.Add("C:\Program Files\Eicon\Aviva\vb\XXXX.a3d", True)

'Set sess = AvivaApp.sessions.Add("C:\Program Files\Eicon\Aviva\Administrator\XXXX1.a3d", True)
Set appwin = sess.appwin
rc% = sess.Connect(True)
rc% = sess.setsharing(3, "")
Set PS = sess.PS

Do Until PS.GetData(40, 3, 20) = "XXXX"
rc% = PS.SendString("{PF3}")
Loop

rc% = PS.SendString("10{Enter}")
rc% = PS.SendString("1{Enter}")
rc% = PS.SendString("9{Enter}")
rc% = PS.SendString("X{Enter}")

excel1 = 4

For y = 4 To 150000
If müşteri.Cells(y, 1) <> 0 Then
XXXX = müşteri.Cells(y, 1)
rc% = PS.Setcursorlocation(14, 36)
rc% = PS.SendString(XXXX)
rc% = PS.SendString("{Enter}")


Do While PS.GetData(4, 1, 2) = "MORE" Or PS.GetData(4, 1, 2) = "VVVV"

For x = 2 To 24
If IsNumeric(PS.GetData(1, x, 32)) Or IsNumeric(PS.GetData(1, x, 48)) Then

müşteri.Cells(excel1, 2) = PS.GetData(3, x, 2)
müşteri.Cells(excel1, 3).Value = XXXX
müşteri.Cells(excel1, 4) = PS.GetData(31, 3, 42)
müşteri.Cells(excel1, 5) = PS.GetData(16, x, 6)
müşteri.Cells(excel1, 6) = PS.GetData(10, x, 23)
müşteri.Cells(excel1, 7) = PS.GetData(3, x, 37)
müşteri.Cells(excel1, 8) = PS.GetData(2, 4, 79)

müşteri.Cells(excel1, 9) = PS.GetData(16, x, 48)

müşteri.Cells(excel1, 10) = PS.GetData(10, x, 66)
müşteri.Cells(excel1, 11) = PS.GetData(3, x, 77)
müşteri.Cells(excel1, 12) = PS.GetData(3, x, 77)
müşteri.Cells(excel1, 17) = PS.GetData(1, 5, 19)
müşteri.Cells(excel1, 18) = PS.GetData(1, 4, 53)
müşteri.Cells(excel1, 19) = PS.GetData(3, 5, 73)

excel1 = excel1 + 1
End If
Next x
rc% = PS.SendString("{Enter}")
Loop
rc% = PS.SendString("X{Enter}")
End If
Next y
End Sub

Sub aksatan()

Set müşteri1 = Worksheets("XXXX")
Set müşteri = Worksheets("XXXX")

Worksheets("XXXX").Select
Range("A4:R65536").Select
Selection.ClearContents
Worksheets("XXXX").Select

Dim AvivaApp As Object
Dim sessions As Object
Dim sess As Object
Dim appwin As Object
Dim data As String

Set AvivaApp = CreateObject("aviva.application")
Set sessions = AvivaApp.sessions
Set sess = AvivaApp.sessions.Add("C:\Program Files\Eicon\Aviva\vb\XXXX.a3d", True)
'Set sess = AvivaApp.sessions.Add("C:\Program Files\Eicon\Aviva\Administrator\XXXX1.a3d", True)
Set appwin = sess.appwin
rc% = sess.Connect(True)
rc% = sess.setsharing(3, "")
Set PS = sess.PS

Do Until PS.GetData(40, 3, 20) = "XXXX"
rc% = PS.SendString("{PF3}")
Loop

rc% = PS.SendString("14{Enter}")
rc% = PS.SendString("5{Enter}")


excel1 = 4

For y = 4 To 150000
If müşteri.Cells(y, 1) <> 0 Then
XXXX = müşteri.Cells(y, 1)
rc% = PS.Setcursorlocation(11, 44)
rc% = PS.SendString(XXXX)
rc% = PS.SendString("{Enter}")

XXXX = müşteri1.Cells(1, 1)
rc% = PS.SendString(XXXX, 13, 65)
rc% = PS.SendString("{Enter}")


Do While PS.GetData(4, 1, 2) = "MORE" Or PS.GetData(4, 1, 2) = "VVVV"

For x = 6 To 24
If IsNumeric(PS.GetData(1, x, 45)) Then
müşteri1.Cells(excel1, 3).Value = XXXX
müşteri1.Cells(excel1, 1) = PS.GetData(4, x, 2)
müşteri1.Cells(excel1, 2) = PS.GetData(4, x, 7)
müşteri1.Cells(excel1, 4) = PS.GetData(18, x, 12)
müşteri1.Cells(excel1, 5) = PS.GetData(1, x, 30)
müşteri1.Cells(excel1, 6) = PS.GetData(14, x, 32)
müşteri1.Cells(excel1, 7) = PS.GetData(14, x, 47)
müşteri1.Cells(excel1, 8) = PS.GetData(3, x, 62)
müşteri1.Cells(excel1, 9) = PS.GetData(5, x, 66)
müşteri1.Cells(excel1, 10) = PS.GetData(41, 2, 39)
rc% = PS.SendString("{PF11}")
rc% = PS.SendString("{PF11}")
rc% = PS.SendString("{PF11}")
müşteri1.Cells(excel1, 11) = PS.GetData(39, x, 37)
rc% = PS.SendString("{PF10}")
rc% = PS.SendString("{PF10}")
rc% = PS.SendString("{PF10}")

excel1 = excel1 + 1
End If
Next x
rc% = PS.SendString("{Enter}")
Loop
rc% = PS.SendString("5{Enter}")

End If
Next y
End Sub


Sub XXXX2()

Set müşteri1 = Worksheets("XXXX")
Set müşteri = Worksheets("XXXX")

Worksheets("XXXX").Select
Range("A4:I65536").Select
Selection.ClearContents
Worksheets("XXXX").Select


Dim sessions As Object
Dim sess As Object
Dim appwin As Object
Dim data As String

Set AvivaApp = CreateObject("aviva.application")
Set sessions = AvivaApp.sessions
Set sess = AvivaApp.sessions.Add("C:\wbg\des2\XXXX1.a3d", True)
'Set sess = AvivaApp.sessions.Add("C:\Program Files\Eicon\Aviva\Administrator\XXXX1.a3d", True)
Set appwin = sess.appwin
rc% = sess.Connect(True)
rc% = sess.setsharing(3, "")
Set PS = sess.PS

Do Until PS.GetData(40, 3, 20) = "XXXX"
rc% = PS.SendString("{PF3}")
Loop

rc% = PS.SendString("12{Enter}")
rc% = PS.SendString("2{Enter}")
rc% = PS.SendString("11{Enter}")

yıl = müşteri1.Cells(1, 2)
rc% = PS.SendString(yıl, 10, 26)
'rc% = ps.SendString("{Enter}")
'rc% = ps.SendString("{Enter}")

excel1 = 4
excel2 = 4
excel3 = 4
excel4 = 4

kayıt = xxxx.Cells(excel3, 1)
While kayıt <> 0

If xxxxi.Cells(excel3, 1) <> 0 Then
XXXX = müşteri.Cells(excel3, 1)
rc% = PS.Setcursorlocation(12, 26)
rc% = PS.SendString(XXXX)
rc% = PS.SendString("{Enter}")
rc% = PS.SendString("{Enter}")

While PS.GetData(4, 3, 9) = "MORE" Or PS.GetData(4, 1, 2) = "MORE"

'If ps.GetData(4, 1, 2) = "MORE" Or ps.GetData(4, 1, 2) = "VVVV" Then


For x = 6 To 24
If IsNumeric(PS.GetData(1, x, 28)) Then

xxxx1.Cells(excel1, 1) = PS.GetData(3, x, 2)
xxxxi1.Cells(excel1, 2) = PS.GetData(12, x, 17)
xxxx1.Cells(excel1, 3) = PS.GetData(10, x, 30)
tarih = Format(PS.GetData(2, 8, 41) & "." & PS.GetData(2, 8, 43) & "." & PS.GetData(4, 8, 45), "dd.mm.yyyy")
xxxx1.Cells(excel1, 4) = tarih
xxxxi1.Cells(excel1, 5) = PS.GetData(8, x, 50)
xxxx1.Cells(excel1, 6) = PS.GetData(8, x, 59)

excel1 = excel1 + 1

End If

Next x


rc% = PS.SendString("{PF11}")
rc% = PS.SendString("{PF11}")
rc% = PS.SendString("{PF11}")
rc% = PS.SendString("{PF10}")
rc% = PS.SendString("{PF10}")

For y = 6 To 24
If IsNumeric(PS.GetData(1, y, 56)) Then
xxxx1.Cells(excel2, 7) = PS.GetData(18, y, 56)
'xxxx1.Cells(excel2, 8) = PS.GetData(14, y, 34)
'xxxx1.Cells(excel2, 9) = PS.GetData(14, y, 66)
excel2 = excel2 + 1
End If
Next y

rc% = PS.SendString("{PF11}")

For a = 6 To 24
If IsNumeric(PS.GetData(1, a, 22)) Then
xxxx1.Cells(excel4, 8) = PS.GetData(17, a, 27)
'xxxxx1.Cells(excel2, 8) = PS.GetData(14, y, 34)
'xxxxx1.Cells(excel2, 9) = PS.GetData(14, y, 66)
excel4 = excel4 + 1
End If
Next a


rc% = PS.SendString("{PF10}")
rc% = PS.SendString("{PF10}")

rc% = PS.SendString("{Enter}")

Wend

'rc% = ps.SendString("{Enter}")

End If
rc% = PS.SendString("11{Enter}")
rc% = PS.SendString(yıl, 10, 26)

'End If
'Next y
excel1 = excel1 + 1
excel2 = excel2 + 1
excel3 = excel3 + 1
excel4 = excel4 + 1
kayıt = müşteri.Cells(excel3, 1)

Wend


Selection.Sort Key1:=Range("B2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
Genişletmek için tıkla ...
 
Son düzenleme:
A

alptun20

Katılım
10 Eylül 2009
Mesajlar
288
Excel Vers. ve Dili
2003 Türkçe
Benim tavsiyem, Altın Üye olarak Video Dersane Bölmündeki anlatımları takip etmeniz, zira bence çok faydalı dersler var. Kısa sürede orta düzeyde makro yazmaya başlayacağınıza eminim, hem siteyede katkınız olur böylelikle..
 
S

ssomar

Katılım
21 Nisan 2008
Mesajlar
44
Excel Vers. ve Dili
excel 2007
en iyi öğrenme biçimi pratiktir...kopyala yapıştırı bırakın...sadece takıldığınız yerde bakın...kod ezberlemeyin...kodu okumayı bilin yeter...pratiğe sürekli devam....siz hissetmeden öğrenmiş olursunuz zaten...
 
K

kodex

Katılım
27 Ağustos 2009
Mesajlar
2
Excel Vers. ve Dili
2007 TÜRKÇE
Tavsiyeleriniz için teşekkürler arkadaşlar.

Bu işi adım adım öğrenebileceğim herhangi bir kaynak var mı?

Bilgisayar bölümlerinden mezun değilim. Yani kod yazmak ve var olan kodları anlama konusunda temel düzeyde anlatabilecek bir kaynağa ihtiyacım var. Bir kaç kitaba baktım ama onlar da 40 yıllık kod yazanlara anlatıyormuş gibi geliyor bana....

şimdiden teşekkürler...
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst