• DİKKAT

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

İki Tarih Arasında ki hareket gören verileri getirme

Erkan Yılmaz

Erkan Yılmaz

Katılım
3 Kasım 2010
Mesajlar
230
Excel Vers. ve Dili
Excel 2016 - Türkçe
Merhabalar,

Kullandığım Ticari programdan Excel tabloya SQL bağlantı ile veri çekiyorum.

Her açılışta programdaki hareketlere göre sorgu yaparak veriler geliyor.

Masraf dosyasına yukarıda ki hücrelerde verdiğim aralıklarda ki hareket gören masraf kodlarının, isimlerinin ve borç alacaklarının gelmesini istiyorum.

Ayrıca Masraf dosyasına aldığımız verilere göre hücre kenarlıklarının kırmızı olmasını istiyorum.

Bu konuda yardımcı olursanız sevinirim.

COSMOBON MALİYET RAPORU.xlsx - 56 KB
 
Ekli dosyayı inceleyin

Yanlış anladığım hücre adresleri varsa siz düzeltiniz.

Kod: 
Private Sub CommandButton2_Click()
Set Sh1 = Sheets("Masraflar Bilnex")
Set sh2 = Sheets("Masraf")
Set sh3 = Sheets("ANA SAYFA")
baslangıc = sh3.Cells(6, "b").Value
bitis = sh3.Cells(6, "c").Value
If IsDate(baslangıc) = True Then
Else
MsgBox "başlangıç değer tarih olarak gözükmüyor"
Exit Sub
End If
If IsDate(bitis) = True Then
Else
MsgBox "bitiş değer tarih olarak gözükmüyor"
End If
sh2.Range("A2:f" & Rows.Count).Clear
deg1 = CDate(baslangıc)
deg2 = CDate(bitis)
sat = 2
If deg1 <= deg2 Then
yer1 = baslangıc

yer2 = bitis - baslangıc
Else
yer1 = bitis
yer2 = baslangıc - bitis
End If


For r = 0 To Val(yer2)
'LookIn:=xlFormulas,LookAt:=xlPart
'LookIn:=xlValues, LookAt:=xlWhole
ad = CDate(yer1 + r)

With Sh1.Range("G2:G65000")
Set d = .Find(What:=ad, After:=.Cells(.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not d Is Nothing Then
FirstAddress = d.Address
Do

sh2.Cells(sat, "A").Value = Sh1.Cells(d.Row, "G").Value
sh2.Cells(sat, "B").Value = Sh1.Cells(d.Row, "AC").Value
sh2.Cells(sat, "C").Value = Sh1.Cells(d.Row, "AG").Value
sh2.Cells(sat, "D").Value = Sh1.Cells(d.Row, "AH").Value
sh2.Cells(sat, "E").Value = Sh1.Cells(d.Row, "AI").Value
sat = sat + 1

Set d = .FindNext(d)
son1 = sh2.[A65536].End(3).Row
sh2.Range("A2:F" & son1).Borders.LineStyle = 1
sh2.Range("A2:F" & son1).Borders.ColorIndex = 3
Application.ScreenUpdating = True
Loop While Not d Is Nothing And d.Address <> FirstAddress
End If
End With
Set Sh = Nothing
Next
sh2.Select
MsgBox "işlem tamam"

End Sub

http://www.dosya.tc/server9/93qldt/COSMOBON_MALIYET_RAPORU.rar.html
 

Ekli dosyalar

Son düzenleme:
tahsinanarat' Alıntı:
Yanlış anladığım hücre adresleri varsa siz düzeltiniz.

Kod: 
Private Sub CommandButton2_Click()
Set Sh1 = Sheets("Masraflar Bilnex")
Set sh2 = Sheets("Masraf")
Set sh3 = Sheets("ANA SAYFA")
baslangıc = sh3.Cells(6, "b").Value
bitis = sh3.Cells(6, "c").Value
If IsDate(baslangıc) = True Then
Else
MsgBox "başlangıç değer tarih olarak gözükmüyor"
Exit Sub
End If
If IsDate(bitis) = True Then
Else
MsgBox "bitiş değer tarih olarak gözükmüyor"
End If
sh2.Range("A2:f" & Rows.Count).Clear
deg1 = CDate(baslangıc)
deg2 = CDate(bitis)
sat = 2
If deg1 <= deg2 Then
yer1 = baslangıc

yer2 = bitis - baslangıc
Else
yer1 = bitis
yer2 = baslangıc - bitis
End If


For r = 0 To Val(yer2)
'LookIn:=xlFormulas,LookAt:=xlPart
'LookIn:=xlValues, LookAt:=xlWhole
ad = CDate(yer1 + r)

With Sh1.Range("G2:G65000")
Set d = .Find(What:=ad, After:=.Cells(.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not d Is Nothing Then
FirstAddress = d.Address
Do

sh2.Cells(sat, "A").Value = Sh1.Cells(d.Row, "G").Value
sh2.Cells(sat, "B").Value = Sh1.Cells(d.Row, "AC").Value
sh2.Cells(sat, "C").Value = Sh1.Cells(d.Row, "AG").Value
sh2.Cells(sat, "D").Value = Sh1.Cells(d.Row, "AH").Value
sh2.Cells(sat, "E").Value = Sh1.Cells(d.Row, "AI").Value
sat = sat + 1

Set d = .FindNext(d)
son1 = sh2.[A65536].End(3).Row
sh2.Range("A2:F" & son1).Borders.LineStyle = 1
sh2.Range("A2:F" & son1).Borders.ColorIndex = 3
Application.ScreenUpdating = True
Loop While Not d Is Nothing And d.Address <> FirstAddress
End If
End With
Set Sh = Nothing
Next
sh2.Select
MsgBox "işlem tamam"

End Sub
Genişletmek için tıkla ...

Sevgili tahsinanarat,

Öncelikle çok teşekkür ediyorum. Ellerine emeğine yüreğine sağlık.

Göndermiş olduğunuz dosyayı alamadım. Altın üyeliğim olmadığı için.

Bir şey daha sormak istiyorum. Bunu makrosuz dizi formülü ile de yapabiliyor muyuz acaba?
 
Sn.Crk@n, 2.nolu mesajımdaki linki şu an denedim o çalışıyor. Bilginize.
 
Merhaba.

İki hususu sorayım;
-- "hareket gören" derken kastınız Masraflar Bilnex adlı sayfadaki tüm veriler midir?
-- "verdiğim aralıklarda" derken, Masraflar Bilnex sayfasında hangi sütundaki tarihler kontrol edilecek?
-- Masraflar Bilnex sayfasındaki sütun yapısı sabit midir?
-- Masraf adlı sayfada oluşmasını istediğiniz tablo başlıklarının, Masraflar Bilnex adlı sayfada hangi sütunlara denk geldiğini net şekilde belirtin.
.
 
Ömer BARAN' Alıntı:
Merhaba.

İki hususu sorayım;
-- "hareket gören" derken kastınız Masraflar Bilnex adlı sayfadaki tüm veriler midir?
-- "verdiğim aralıklarda" derken, Masraflar Bilnex sayfasında hangi sütundaki tarihler kontrol edilecek?
-- Masraflar Bilnex sayfasındaki sütun yapısı sabit midir?
-- Masraf adlı sayfada oluşmasını istediğiniz tablo başlıklarının, Masraflar Bilnex adlı sayfada hangi sütunlara denk geldiğini net şekilde belirtin.
.
Genişletmek için tıkla ...



Sevgili Ömer BARAN,

Öncelikle teşekkür ederim ilgi ve alakan için.

1. Evet Masraf Bilnex sayfasındaki hareket gören veriler.

2. Masraf Bilnexdeki AD sütunun kontrol edilecek.

3. Masraf Bilnex deki sütun sayısı sabit satır sayıları SQL ile geleceği hareketli olacaktır.

4. Masraf Kodu = Masraflar Bilnex AC

Borç = Masrflar Bilnex AH

Alacak = Masraflar Bilnex AI
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst