Excel Vba Forum - Excelce.Net
SORU ve CEVAPLAR (Yazılabilir) => Microsoft Excel, Vba, Makro, Formül vb. Soruları => Çözülen Excel, Vba, Makro, Formül vb. Soruları => Konuyu başlatan: a_self_lion - 20 Temmuz 2010, 16:07:40
-
Selam arkadaşlar. Aşağıda örnek dosya olarak göndermiş olduğum vba projemde
Sorgu ile çağırıp rst. de sıra ile almış olduğum verilerimi excel kitabımdaki sayfa1 deki a sutunundaki yazılı olan malzeme kodarıma göre bir karşılaştırma yapıp aşağı sorğu eğer uyuşuyorsa b c d sutunlarına yine rst.field deki alanları yazsın uyuşmuyorsa bir sonraki kayda geçerek baksın. Bunu nasıl yapablirim. Örnek dosya ve detaylı açıklama ektedir. Anlaşılmayan bir bölümünü yine anlatabilirim.
Şimdiden teşekkürler.
[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]
-
Veriitabanınada ekleseydiniz iyi olurdu.
Kontrol etme imkanı olurdu.
Şimdi böyle kontrol etemeden afaki oldu.
Ayrıca bu kodları azcık düzen intizama sokup yollasaydınız daha iyi olurdu.
Biz zahmete girip cevap yazıyoruz.Sizde azcık zahmete girip bunları yapabilirdiydiniz.
Aşağıdaki kodları deneyiniz. 8)
'UYGUNSUZ ÜRÜN GEL
Set z = CreateObject("Scripting.dictionary")
sat = Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
For I = 8 To Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
If Not z.exists(Sheets("Sayfa1").Cells(I, "A").Value) Then
z.Add CStr(Sheets("Sayfa1").Cells(I, "A").Value), I
End If
Next I
Dim BASTAR As String
Dim BITTAR As String
Dim BSYIL As String
Dim BSAY As String
Dim BSGUN As String
Dim BTYIL As String
Dim BTAY As String
Dim BTGUN As String
Dim DEPARTMAN As String
Dim SQLText As String
Dim I As Long
Dim RST As New ADODB.Recordset
Call Main
DoEvents
SQLCON.Open
BSYIL = Range("B3")
BSAY = Range("C3")
BSGUN = Range("D3")
BTYIL = Range("B4")
BTAY = Range("C4")
BTGUN = Range("D4")
BASTAR = BSYIL + " - " + BSAY + " - " + BSGUN
BITTAR = BTYIL + " - " + BTAY + " - " + BTGUN
DEPARTMAN = Range("C1")
SQLText = "SELECT ENVANTER_MLZ,STOK_ADI1,ENVANTER_DEV_MIK,ENVANTER_GIR_MIK,ENVANTER_URT_MIK,ENVANTER_ART_MIK,ENVANTER_RZG_MIK, " & vbCrLf
SQLText = SQLText & " ENVANTER_CIK_MIK,ENVANTER_IML_MIK,ENVANTER_EKS_MIK,ENVANTER_HAS_MIK,ENVANTER_IAD_MIK,ENVANTER_SAT_MIK " & vbCrLf
SQLText = SQLText & " FROM ENVANTER " & vbCrLf
SQLText = SQLText & " LEFT OUTER JOIN STOK ON STOK_KOD = ENVANTER_MLZ " & vbCrLf
SQLText = SQLText & " WHERE ENVANTER_CPFACD = '" + DEPARTMAN + "' AND " & vbCrLf
SQLText = SQLText & " ENVANTER_TAR = '" + BITTAR + "' " & vbCrLf
Set RST.DataSource = SQLCON.Execute(SQLText)
'Range("A8:O65000").Select
'Selection.ClearContents
Dim deger As String
Do Until RST.EOF
For I = 1 To RST.RecordCount Step 1
deger = CStr(RST.Fields(0).Value)
If z.exists(deger) Then
Sheets("Sayfa1").Cells(z.Item(deger), 3) = RST.Files(2)
Sheets("Sayfa1").Cells(z.Item(deger), 4) = RST.Fields(3) + RST.Fields(4) + RST.Fields(5) + RST.Fields(6) ' _GIR_MIK + _URT_MIK + _ART_MIK + _RZG_MIK
Sheets("Sayfa1").Cells(z.Item(deger), 5) = RST.Fields(7) + RST.Fields(8) + RST.Fields(9) + RST.Fields(10) + RST.Fields(11) + RST.Fields(12) ' _CIK_MIK + _IML_MIK + _EKS_MIK + _HAS_MIK + _IAD_MIK + _SAT_MIK
Sheets("Sayfa1").Cells(z.Item(deger), 6) = (RST.Fields(2) + RST.Fields(3) + RST.Fields(4) + RST.Fields(5) + RST.Fields(6)) - (RST.Fields(7) + RST.Fields(8) + RST.Fields(9) + RST.Fields(10) + RST.Fields(11) + RST.Fields(12))
Label1.Caption = "% " & Round(I / RST.RecordCount * 100, 0)
End If
RST.MoveNext
Next I
Loop
RST.Close
SQLCON.Close
Range("B7").Select
-
Set z = CreateObject("Scripting.dictionary")
sat = Sheets("Sayfa5").Cells(65536, "A").End(xlUp).Row
For a = 8 To Sheets("Sayfa5").Cells(65536, "A").End(xlUp).Row
If Not z.exists(Sheets("Sayfa5").Cells(a, "A").Value) Then
z.Add CStr(Sheets("Sayfa5").Cells(a, "A").Value), a
End If
Next a
Dim BASTAR As String
Dim BITTAR As String
Dim BSYIL As String
Dim BSAY As String
Dim BSGUN As String
Dim BTYIL As String
Dim BTAY As String
Dim BTGUN As String
Dim DEPARTMAN As String
Dim SQLText As String
Dim I As Integer
Dim RST As New ADODB.Recordset
Call Main
DoEvents
SQLCON.Open
BSYIL = Range("B3")
BSAY = Range("C3")
BSGUN = Range("D3")
BTYIL = Range("B4")
BTAY = Range("C4")
BTGUN = Range("D4")
BASTAR = BSYIL + " - " + BSAY + " - " + BSGUN
BITTAR = BTYIL + " - " + BTAY + " - " + BTGUN
DEPARTMAN = Range("C1")
SQLText = "SELECT ENVANTER_MLZ,STKMLZ_ADI1,ENVANTER_DEV_MIK,ENVANTER_GIR_MIK,ENVANTER_URT_MIK,ENVANTER_ART_MIK,ENVANTER_RZG_MIK, " & vbCrLf
SQLText = SQLText & " ENVANTER_CIK_MIK,ENVANTER_IML_MIK,ENVANTER_EKS_MIK,ENVANTER_HAS_MIK,ENVANTER_IAD_MIK,ENVANTER_SAT_MIK " & vbCrLf
SQLText = SQLText & " FROM ENVANTER " & vbCrLf
SQLText = SQLText & " LEFT OUTER JOIN STKMLZ ON STKMLZ_KOD = ENVANTER_MLZ " & vbCrLf
SQLText = SQLText & " WHERE ENVANTER_CPFACD = '" + DEPARTMAN + "' AND " & vbCrLf
SQLText = SQLText & " ENVANTER_TAR = '" + BITTAR + "' " & vbCrLf
Set RST.DataSource = SQLCON.Execute(SQLText)
'Range("A8:O65000").Select
'Selection.ClearContents
Dim deger As String
Do Until RST.EOF
For I = 1 To RST.RecordCount Step 1
deger = CStr(RST.Fields(0).Value)
If z.exists(deger) Then
Sheets("Sayfa5").Cells(z.Item(deger), 3) = RST.Fields(2)
Sheets("Sayfa5").Cells(z.Item(deger), 4) = RST.Fields(3) + RST.Fields(4) + RST.Fields(5) + RST.Fields(6) ' _GIR_MIK + _URT_MIK + _ART_MIK + _RZG_MIK
Sheets("Sayfa5").Cells(z.Item(deger), 5) = RST.Fields(7) + RST.Fields(8) + RST.Fields(9) + RST.Fields(10) + RST.Fields(11) + RST.Fields(12) ' _CIK_MIK + _IML_MIK + _EKS_MIK + _HAS_MIK + _IAD_MIK + _SAT_MIK
Sheets("Sayfa5").Cells(z.Item(deger), 6) = (RST.Fields(2) + RST.Fields(3) + RST.Fields(4) + RST.Fields(5) + RST.Fields(6)) - (RST.Fields(7) + RST.Fields(8) + RST.Fields(9) + RST.Fields(10) + RST.Fields(11) + RST.Fields(12))
'Cells(I + 7, 1) = RST.Fields(0) ' _MLZ
'Cells(I + 7, 2) = RST.Fields(1) ' _STKMLZ_ADI1 LEFT OUTER JOIN
'Cells(I + 7, 3) = RST.Fields(2) ' _DEV_MIK
'Cells(I + 7, 4) = RST.Fields(3) + RST.Fields(4) + RST.Fields(5) + RST.Fields(6) ' _GIR_MIK + _URT_MIK + _ART_MIK + _RZG_MIK
'Cells(I + 7, 5) = RST.Fields(7) + RST.Fields(8) + RST.Fields(9) + RST.Fields(10) + RST.Fields(11) + RST.Fields(12) ' _CIK_MIK + _IML_MIK + _EKS_MIK + _HAS_MIK + _IAD_MIK + _SAT_MIK
'Cells(I + 7, 6) = (RST.Fields(2) + RST.Fields(3) + RST.Fields(4) + RST.Fields(5) + RST.Fields(6)) - (RST.Fields(7) + RST.Fields(8) + RST.Fields(9) + RST.Fields(10) + RST.Fields(11) + RST.Fields(12))
Label1.Caption = "% " & Round(I / RST.RecordCount * 100, 0)
End If
RST.MoveNext
Next I
Loop
RST.Close
SQLCON.Close
Range("B7").Select
End Sub
Sayın hocam kodları gönderdiğiniz gibi yaptım denedim ama burda hata veriyor Tam anlayamadım.
sat = Sheets("Sayfa5").Cells(65536, "A").End(xlUp).Row
Bir daha bakabilirmisiniz.
-
O sizde sayfa5 isimli sayfa yoksa yapar.Kendi sayfanızın adını yazmalısınız.
O satırı komple silin.Gerek yok ona.Ayrıca bir baksanız diyorsunuz.Neye bakıcam.Dosya yollammışsınız ki kontrol edeyim.Onlarıda kontrol emeden afaki yazdım.Olursa olur olmazsa olmaz .Niye olmadı diyemezsiniz.Olursa kullanabilirsiniz ancak.Çünkü teste etmeye imkanım yok.Biz bu kodları yazarken ayriyetten test ediyoruz çalışıyormu çalılşmıyormu diye .Bazen bir kaç denemeden sonra çalışır hale geliyor.Afaki yazılmıyor kodlar.Çalışır vaziyete soktuktan sonra size yolluyoruz. 8)
-
Hocam süpersiniz sayfa5 ben excelin kendi verdiği sayfa adını yazmıştım. Sonra sizinde dediğiniz gibi kendi verdiğimiz adını yazınca süper ve çok hızlı bir şekilde çalıştı.
Allah sizden razı olsun.
Ayrıca bir ricam daha olucak ben excelde bu kodları yazabilmek için excel vba ile ilgili ileri bir kitap arıyorum bildiğiniz tavsiye edebileceğiniz bir kitap varmıdır? Teşekkürler tekrardan. (Programlama bilgim var)
-
Hocam süpersiniz sayfa5 ben excelin kendi verdiği sayfa adını yazmıştım. Sonra sizinde dediğiniz gibi kendi verdiğimiz adını yazınca süper ve çok hızlı bir şekilde çalıştı.
Allah sizden razı olsun.
Ayrıca bir ricam daha olucak ben excelde bu kodları yazabilmek için excel vba ile ilgili ileri bir kitap arıyorum bildiğiniz tavsiye edebileceğiniz bir kitap varmıdır? Teşekkürler tekrardan. (Programlama bilgim var)
Bilmiyorum.
Ben bu konuda hiç kitap okumadım.
Bülent bey belki bir tavsiyede bulunabilir.
Kolay gelsin. 8)
-
Merhaba Özcan Bey.
Benim alıp kullandığım bir kitap olmadı şimdiye kadar.
Deneme yanılma yolu, Excel'in F1 tuşu ve Google en büyük yardımcım oldu.
Kitaplarını görmediğim, ama bilgisine ve anlatımına güvendiğim M. Temel Korkmaz hocanın kitabını tavsiye ederim yine de.
http://www.excel.gen.tr/siparis.asp
İyi çalışmalar.