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.