ExcelVBA.Net sitesine katkıda bulunabilirsiniz

[talebeyim]

Arkadaşlar Dış veri alma yöntemiyle bir çalışma yapıyorum.
Makroyu çalıştırdığımda;
1. Table2 sayfasındaki dış veri bağlantısını güncelleyecek.
2. Data sayfasında C sütunun altta kalan kısmına kopyalayacak.
3. A Sütununa sıra numarası B sütununa ise O günü tarihini yazacak.

Bu şekilde bir çalışma hakkında yardımcı olabilir misiniz?
Teşekkür ederim.

[Tarkan VURAL]

Merhaba,
Şu kodları hazırladım, deneyebilirsiniz.

Kod: Tümünü seç

Sub Guncelle()
With Sheets("Table 2")
son = Sheets("Data").Range("a65536").End(3).Row
    .Range("a1").ListObject.QueryTable.Refresh
    .Range("a2:f" & .Range("F65536").End(3).Row).Copy
    With Sheets("Data")
        .Range("c65536").End(3)(2, 1).PasteSpecial xlPasteValues
        .Select
        .Range("a" & son - 1 & ":a" & son).Select
        son2 = .Range("c65536").End(3).Row
        Selection.AutoFill Destination:=.Range("a" & son - 1 & ":a" & son2)
        .Range("b" & son + 1 & ":b" & son + 2).Value = Date
        .Range("b" & son + 1 & ":b" & son + 2).Select
        Selection.AutoFill Destination:=.Range("b" & son + 1 & ":b" & son2)
    End With
End With
End Sub

[talebeyim]

Merhaba,
Şu kodları hazırladım, deneyebilirsiniz.

Kod: Tümünü seç

Sub Guncelle()
With Sheets("Table 2")
son = Sheets("Data").Range("a65536").End(3).Row
    .Range("a1").ListObject.QueryTable.Refresh
    .Range("a2:f" & .Range("F65536").End(3).Row).Copy
    With Sheets("Data")
        .Range("c65536").End(3)(2, 1).PasteSpecial xlPasteValues
        .Select
        .Range("a" & son - 1 & ":a" & son).Select
        son2 = .Range("c65536").End(3).Row
        Selection.AutoFill Destination:=.Range("a" & son - 1 & ":a" & son2)
        .Range("b" & son + 1 & ":b" & son + 2).Value = Date
        .Range("b" & son + 1 & ":b" & son + 2).Select
        Selection.AutoFill Destination:=.Range("b" & son + 1 & ":b" & son2)
    End With
End With
End Sub

Tarkan bey Çok çok teşekkür ederim Yine sizden nokta atışı.

[talebeyim]

Merhaba,
Şu kodları hazırladım, deneyebilirsiniz.

Kod: Tümünü seç

Sub Guncelle()
With Sheets("Table 2")
son = Sheets("Data").Range("a65536").End(3).Row
    .Range("a1").ListObject.QueryTable.Refresh
    .Range("a2:f" & .Range("F65536").End(3).Row).Copy
    With Sheets("Data")
        .Range("c65536").End(3)(2, 1).PasteSpecial xlPasteValues
        .Select
        .Range("a" & son - 1 & ":a" & son).Select
        son2 = .Range("c65536").End(3).Row
        Selection.AutoFill Destination:=.Range("a" & son - 1 & ":a" & son2)
        .Range("b" & son + 1 & ":b" & son + 2).Value = Date
        .Range("b" & son + 1 & ":b" & son + 2).Select
        Selection.AutoFill Destination:=.Range("b" & son + 1 & ":b" & son2)
    End With
End With
End Sub

Tarkan bey Çok çok teşekkür ederim Yine sizden nokta atışı.

Tarkan bey bir yeri atlamışım. Oda şu eğer dataya aktaracağımız tarih orada var ise,
dış veri ile aldığımız bilgilerin üzerine yazmalı.

Örnek veriyorum.

Hisse senetlerinin fiyatlarını iki kere çekersek "Bu veriler daha önce çekildi, Üzerine yazmak istediğine emin misin gibi diyerek" en son yazdığını üzerine yazmalı.

[Tarkan VURAL]

Merhaba,
CalculateUntilAsyncQueriesDone özelliği ile Dış Veri Al yöntemiyle alınan tablo verileri güncellemesi bittikten sonra diğer kodlar devam edecek. Bazen tablo tamamlanmadan önce kopyalamaya geçiliyordu.

Kod: Tümünü seç

Sub Guncelle()
With Sheets("Table 2")
son = Sheets("Data").Range("a65536").End(3).Row
    .Rows("4:" & .Range("F65536").End(3).Row).Delete
    .Range("a1").ListObject.QueryTable.Refresh
    Application.CalculateUntilAsyncQueriesDone
        Set bul = Sheets("Data").Range("b2:B" & son).Find(What:=Date, lookat:=xlWhole)
        If Not bul Is Nothing Then
        cevap = MsgBox(Date & " tarihinde veriler daha önce çekilmiş." & vbNewLine & _
        "Üzerine yazılsın mı ? ", vbYesNo + vbQuestion, "EVN")
            If cevap = vbYes Then
            sil = Sheets("Data").Range("b65536").End(3).Row
                For x = sil To bul.Row Step -1
                    DoEvents
                    Sheets("Data").Rows(x).Delete
                Next x
            Else
                Exit Sub
            End If
        End If
        .Range("a2:f" & .Range("F65536").End(3).Row).Copy
        With Sheets("Data")
            .Select
            .Range("c65536").End(3)(2, 1).PasteSpecial xlPasteValues
            son = Sheets("Data").Range("a65536").End(3).Row
            .Range("a" & son - 1 & ":a" & son).Select
            son2 = .Range("c65536").End(3).Row
            Selection.AutoFill Destination:=.Range("a" & son - 1 & ":a" & son2)
            .Range("b" & son + 1 & ":b" & son2).Value = Date
        End With

End With
End Sub