- Katılım
- 12 Aralık 2020
- Mesajlar
- 74
- Excel Vers. ve Dili
- 2016 tr
Hocalarım merhaba
Bu kodda sorgu ilk tarih (ay-gün) ve son tarih (ay gün) olacak şekilde döngüye sokmak istiyorum ama döngü hiç durmuyor sürekli devam ediyor , nerde hata var ?
Kod:
Private Sub CommandButton1_Click() ' veri al
On Error Resume Next
Dim i As Integer
Dim url1, url2, url3, url4, url5 As String
Dim c As Integer
Dim j As Integer
Dim ay As Integer
Dim ay2 As Integer
Dim ilkgun As Integer
Dim songun As Integer
Dim s_say As Long, b_say As Long
Dim s1_say As Long, b1_say As Long
Dim muko As Integer
Dim cenk As Integer
Dim k As Integer
ay = Sayfa2.Cells(6, 10)
ay2 = Sayfa2.Cells(6, 13)
ilkgun = Sayfa2.Cells(6, 11)
songun = Sayfa2.Cells(6, 12)
For k = ay To ay2
For j = ilkgun To songun
url1 = "LİNK VAR"
If k < 10 Then
url2 = "&sorguIlkTarih=2021" & "0" & k & "0" & j
Else
url2 = "&sorguIlkTarih=2021" & k & j
If j < 10 Then
url2 = "&sorguIlkTarih=2021" & "0" & ay & "0" & j
Else
url2 = "&sorguIlkTarih=2021" & ay & j
End If
If ay2 < 10 Then
url3 = "&sorguSonTarih=2021" & "0" & ay2 & "0" & songun
Else
url3 = "&sorguSonTarih=2021" & ay2 & songun
End If
If songun < 10 Then
url3 = "&sorguSonTarih=2021" & ay2 & "0" & songun
Else
url3 = "&sorguSonTarih=2021" & ay2 & songun
End If
url4 = [url1] & [url2] & [url3]
With ActiveSheet.QueryTables.Add(Connection:="URL;" & url4, _
Destination:=Range("D1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sayfa2.Cells(10, 10) = url4
s1_say = Sayfa2.Range("B1:B10000").Rows.Count
b1_say = WorksheetFunction.CountBlank(Sayfa2.Range("B1:B10000"))
cenk = s1_say - b1_say
c = cenk + 1
s_say = Sayfa1.Range("E1:E10000").Rows.Count
b_say = WorksheetFunction.CountBlank(Sayfa1.Range("E1:E10000"))
muko = s_say - b_say
For i = 3 To muko
'//////////////////////////////////////////////////////////////////////
Sayfa2.Cells(c, 1) = a ' tarih
Sayfa2.Cells(c, 2) = Sayfa1.Cells(i, 5) ' barkod
Sayfa2.Cells(c, 3) = Sayfa1.Cells(i, 6) 'ilk işlem tarihi
Sayfa2.Cells(c, 4) = Sayfa1.Cells(i, 7) 'ilk işlem merkez
Sayfa2.Cells(c, 5) = Sayfa1.Cells(i, 8) 'ilk işlem
Sayfa2.Cells(c, 6) = Sayfa1.Cells(i, 9) 'son işlem tarihi
Sayfa2.Cells(c, 7) = Sayfa1.Cells(i, 10) 'son işlem merkez
Sayfa2.Cells(c, 8) = Sayfa1.Cells(i, 11) 'son işlem
'ThisWorkbook.Worksheets("Sayfa2").Range("B2").End(xlDown).Offset(1, 2).Select = Sayfa1.Cells(i, 5)
'/////////////////////////////////////////////
'//////////////////////////////////////////////////////////////////////
c = c + 1
'Sayfa1.Cells(42, 2) = i
'Sayfa1.Cells(43, 2) = Sayfa1.Cells(41, 2) - i + 1
Next [i]
Range("D1:AB1201").Select
Selection.QueryTable.Delete
Selection.QueryTable.Delete
Selection.ClearContents
Next [j]
Next [k]
Call Makro1
' Sayfa1.Cells(41, 2) = ""
Sayfa1.Cells(42, 2) = ""
Sayfa1.Cells(43, 2) = ""
End Sub
Bu kodda sorgu ilk tarih (ay-gün) ve son tarih (ay gün) olacak şekilde döngüye sokmak istiyorum ama döngü hiç durmuyor sürekli devam ediyor , nerde hata var ?