(17/07/2020, 15:40)feraz yazdı: Berduş hocam sizin kod bazılarında hata veriyor.haklısınız hatalı olan benim dosya weekday(Trh) fonksiyonun gün parametresi girmeyi unuttuğumdan yanlış hesaplıyormuş
dogrusu weekday(Trh,2) şeklinde olmalıydı. düzeltilmiş kod:
Application.ScreenUpdating = False
Dim SQL, TbU As String
Dim ADO_RS As ADODB.Recordset
Dim ADO_CN As ADODB.Connection
'Hafta ici bulmak icin
With ActiveSheet
.Range("A3:C" & Rows.Count).ClearContents
For Each syf In Worksheets
If syf.Name <> .Name Then
TbU = TbU & "Union all " & "SELECT F1 as NobetTrh, F2 as Nobetci FROM [" & syf.Name & "$A3:B] "
End If
Next
End With
TbU = Mid(TbU, 11)
SQL = "SELECT TbU.Nobetci, Sum(IIf(Weekday([NobetTrh],2)<6,1,0)) AS Hftici, Sum(IIf(Weekday([NobetTrh],2)>5,1,0)) AS HftSon " & _
"FROM(" & TbU & ") As TbU " & _
"GROUP BY TbU.Nobetci " & _
"HAVING (((TbU.Nobetci)<>''));"
Set ADO_RS = New ADODB.Recordset
Set ADO_CN = New ADODB.Connection
ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=no"""
ADO_CN.Open
ADO_RS.Open SQL, ADO_CN, 3, 1
'
' Eğer Hiç Kayıt Yoksa
If ADO_RS.RecordCount = 0 Then
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"
Exit Sub
End If
ADO_RS.MoveLast
ADO_RS.MoveFirst
Sheets("Toplam Liste").Range("A3").CopyFromRecordset ADO_RS
' ComboBox1.Column = ADO_RS.GetRows
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
son:
Application.ScreenUpdating = True
End Sub
