Merhaba arkadaşlar aşağıdaki gibi bir kod yazdım ancak alan 18 de bulunan veri ile karşılaştırmayı yaptıramıyorum. Sorun nedir acaba?
Sub test()
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim ws As Worksheet
Dim ktiter As String
Dim satir As Range
Dim satirno As Long
Dim sutun As Integer
Dim ws2 As Worksheet
Dim toplamsatir As Long
Dim alan18icin As String
Dim ws3 As Worksheet
Dim r1 As Range
Dim r2 As Range
Set ws = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set ws3 = Worksheets("Sheet3")
With cn
.Provider = "Microsoft.JET.OLEDB.4.0"
.Open ("c:\Havuz\Havuz.mdb")
End With
ws2.Rows(1).Value = ws.Rows(1).Value
'satirno = 1
satirno = ws3.Cells(1, 2)
toplamsatir = ws3.Cells(2, 2)
sutun = 20
'toplamsatir = ws.Range("A1").CurrentRegion.Rows.Count
Do
'ws2.Rows(satirno).Value = ws.Rows(satirno).Value
ws.Select
Range(Cells(satirno, 1), Cells(satirno, 20)).Copy
ws2.Select
Range(Cells(satirno, 1), Cells(satirno, 20)).PasteSpecial (xlPasteAll)
kriter = Worksheets("Sheet1").Cells(satirno, 1)
alan18icin = Worksheets("Sheet1").Cells(satirno, 14)
If Not kriter = "" Then
Set rs = New ADODB.Recordset
rs.Open "SELECT DISTINCT HAKSAHIBI, TEMSILORANI, DAGITIMNOTU, Alan18 FROM Havuz_temsili WHERE SARKI='" + kriter + "'", cn, adOpenStatic, LockType:=adLockOptimistic
Do Until rs.EOF
'Worksheets("Sheet2").Cells(2, 1) = "SELECT SARKI FROM Havuz WHERE SARKI='" + kriter + "'"
Worksheets("Sheet2").Cells(satirno, sutun) = rs.Fields(0).Value
Worksheets("Sheet2").Cells(satirno, sutun + 1) = rs.Fields(1).Value
Worksheets("Sheet2").Cells(satirno, sutun + 2) = rs.Fields(2).Value
If rs.Fields(2).Value <> alan18icin Then
Worksheets("Sheet2").Cells(satirno, sutun + 3) = rs.Fields(3).Value
End If
'Worksheets("Sheet2").Cells(satirno, sutun) = alan18icin
rs.MoveNext
sutun = sutun + 5
Loop
sutun = 20
rs.Close
Set rs = Nothing
End If
satirno = satirno + 1
Loop Until satirno = toplamsatir
cn.Close
Set cn = Nothing
End Sub
Sub test()
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim ws As Worksheet
Dim ktiter As String
Dim satir As Range
Dim satirno As Long
Dim sutun As Integer
Dim ws2 As Worksheet
Dim toplamsatir As Long
Dim alan18icin As String
Dim ws3 As Worksheet
Dim r1 As Range
Dim r2 As Range
Set ws = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set ws3 = Worksheets("Sheet3")
With cn
.Provider = "Microsoft.JET.OLEDB.4.0"
.Open ("c:\Havuz\Havuz.mdb")
End With
ws2.Rows(1).Value = ws.Rows(1).Value
'satirno = 1
satirno = ws3.Cells(1, 2)
toplamsatir = ws3.Cells(2, 2)
sutun = 20
'toplamsatir = ws.Range("A1").CurrentRegion.Rows.Count
Do
'ws2.Rows(satirno).Value = ws.Rows(satirno).Value
ws.Select
Range(Cells(satirno, 1), Cells(satirno, 20)).Copy
ws2.Select
Range(Cells(satirno, 1), Cells(satirno, 20)).PasteSpecial (xlPasteAll)
kriter = Worksheets("Sheet1").Cells(satirno, 1)
alan18icin = Worksheets("Sheet1").Cells(satirno, 14)
If Not kriter = "" Then
Set rs = New ADODB.Recordset
rs.Open "SELECT DISTINCT HAKSAHIBI, TEMSILORANI, DAGITIMNOTU, Alan18 FROM Havuz_temsili WHERE SARKI='" + kriter + "'", cn, adOpenStatic, LockType:=adLockOptimistic
Do Until rs.EOF
'Worksheets("Sheet2").Cells(2, 1) = "SELECT SARKI FROM Havuz WHERE SARKI='" + kriter + "'"
Worksheets("Sheet2").Cells(satirno, sutun) = rs.Fields(0).Value
Worksheets("Sheet2").Cells(satirno, sutun + 1) = rs.Fields(1).Value
Worksheets("Sheet2").Cells(satirno, sutun + 2) = rs.Fields(2).Value
If rs.Fields(2).Value <> alan18icin Then
Worksheets("Sheet2").Cells(satirno, sutun + 3) = rs.Fields(3).Value
End If
'Worksheets("Sheet2").Cells(satirno, sutun) = alan18icin
rs.MoveNext
sutun = sutun + 5
Loop
sutun = 20
rs.Close
Set rs = Nothing
End If
satirno = satirno + 1
Loop Until satirno = toplamsatir
cn.Close
Set cn = Nothing
End Sub
