• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Döngüdeki Hata

Katılım
12 Aralık 2020
Mesajlar
74
Excel Vers. ve Dili
2016 tr
Hocalarım merhaba

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 ?
 
Şöyle özetleyeyim döngüdeki ilk tarih 20210101 formatında son tarihte 20211020 burdaki ilk tarih ay ve gün son tarih ay ve güne kadar rapor çektirmek istiyorum
 
Geri
Üst