Soru Tarih Döngüsü oluşturmak

[editedbycenk]

Merhaba

Elimde 20211015 tarzında yani YYYYAAGG bir tarih formatı var , ay ve günü başka bir sayfadan ilk ay ilk gün son ay songün şeklinde çağıracağım bu tarihi nasıl döngüye sokarım

 

[Korhan Ayhan]

Bahsettiğiniz bu tarih verisi hücrede mi bulunuyor? Eğer hücrede bulunuyorsa veri gerçekte tarih mi? Biçimi bahsettiğiniz şekilde mi ayarlı?

 

[editedbycenk]

Bahsettiğiniz bu tarih verisi hücrede mi bulunuyor? Eğer hücrede bulunuyorsa veri gerçekte tarih mi? Biçimi bahsettiğiniz şekilde mi ayarlı?

Hayır hücrede bulunmuyor ilk gün ilk ay son gün son ay bir hücrede bulunuyor onlarda metin değerinde

 

[editedbycenk]

Hayır hücrede bulunmuyor ilk gün ilk ay son gün son ay bir hücrede bulunuyor onlarda metin değerinde

Yani ben iki tarih aralığı belirleyeceğim oda döngüye sokacak

 

[Korhan Ayhan]

Örnek dosya paylaşabilir misiniz?

 

[ismailem]

Sub ikitariharasigunfarki()

Dim tarih1 As Date
Dim tarih2 As Date
Dim tmetin1, tmetin2 As String
Dim fark As Long
Dim i As Integer
tmetin1 = "20210115"
tmetin2 = "20211015"
tarih1 = DateSerial(CInt(Mid(tmetin1, 1, 4)), CInt(Mid(tmetin1, 5, 2)), CInt(Mid(tmetin1, 7, 2)))
tarih2 = DateSerial(CInt(Mid(tmetin2, 1, 4)), CInt(Mid(tmetin2, 5, 2)), CInt(Mid(tmetin2, 7, 2)))

fark = DateDiff("d", tarih1, tarih2)
For i = 0 To fark - 1
'.................
Next i
MsgBox fark

End Sub
Probleminiz pek anlaşılmadığı için ilham versin diye bu kodu oluşturdum.

 

[editedbycenk]

Sub ikitariharasigunfarki()

Dim tarih1 As Date
Dim tarih2 As Date
Dim tmetin1, tmetin2 As String
Dim fark As Long
Dim i As Integer
tmetin1 = "20210115"
tmetin2 = "20211015"
tarih1 = DateSerial(CInt(Mid(tmetin1, 1, 4)), CInt(Mid(tmetin1, 5, 2)), CInt(Mid(tmetin1, 7, 2)))
tarih2 = DateSerial(CInt(Mid(tmetin2, 1, 4)), CInt(Mid(tmetin2, 5, 2)), CInt(Mid(tmetin2, 7, 2)))

fark = DateDiff("d", tarih1, tarih2)
For i = 0 To fark - 1
'.................
Next i
MsgBox fark

End Sub
Probleminiz pek anlaşılmadığı için ilham versin diye bu kodu oluşturdum.

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

hocam kodum bu burdaki ay gün döngüsüne bakarsanız biraz fikir verir

 

[editedbycenk]

İlgili linkte önce 20210101 sayfasını açsın sonra 20210102 ….. böyle böyle son belirlediğim tarihe kadar açsın istiyorum

 

[ismailem]

İlgili linkte önce 20210101 sayfasını açsın sonra 20210102 ….. böyle böyle son belirlediğim tarihe kadar açsın istiyorum

Yaptığınız projede özel kişi bilgilerini hayali isimlerle değiştirerek kişilerin ve özel bilgilerinizi paylaşmadan da projenizi paylaşıp daha da yardımcı olunabilecek duruma getirebilirsiniz. Sizin hayal gücünüzdeki zengin kütüphanenizi kendi hayal kütüphanemize taşıyamıyoruz. excel sorununuzu daha iyi anlamanın excel dosyanızı paylaşmaktır. Excel dosyanızda istenilen kodu düzeltmeyi talep etmektir.