Belli bir zamanda veriyi sabitlemek

[Ömer]

Kodları aşağıdakilerle değiştirerek deneyin.

Sub aktar()
 
    Dim tarih As Date, c As Range, d As Range, i As Byte, sut As Integer
 
    Application.ScreenUpdating = False
    Sheets("Aylik Gerceklesmeler").Select
 
    tarih = DateSerial(Year(Date), Month(Date) - 1, 1)
 
    Set c = Rows(17).Find(tarih)
    If Not c Is Nothing Then
        sut = c.Column
    End If
 
    For i = 3 To 32
        Set d = Range("C17:C" & _
            Rows.Count).Find(Cells(3, i), , xlValues, xlWhole)
        If Not d Is Nothing Then
            Cells(d.Row, sut) = Cells(4, i)
        End If
    Next i
 
End Sub

.

 

[evuye]

Hata verdi maalesef.
Ekte ekran görüntüsünü gönderiyorum.

 

[Ömer]

Görmediği için bulamıyor. Bunu ayrıca araştıracağım.

Kodları aşağıdakilerle değiştirip deneyin.

Sub aktar()
 
    Dim tarih As Date, c As Range, d As Range, i As Byte, sut As Integer
 
    Application.ScreenUpdating = False
    Sheets("Aylik Gerceklesmeler").Select
 
   [COLOR=blue]Cells.EntireColumn.AutoFit[/COLOR]
 
    tarih = DateSerial(Year(Date), Month(Date) - 1, 1)
 
    Set c = Rows(17).Find(tarih)
    If Not c Is Nothing Then
        sut = c.Column
    End If
 
    For i = 3 To 32
        Set d = Range("C17:C" & _
            Rows.Count).Find(Cells(3, i), , xlValues, xlWhole)
        If Not d Is Nothing Then
            Cells(d.Row, sut) = Cells(4, i)
        End If
    Next i
 
End Sub

.

 

[evuye]

Ömer Bey, tüm müdürlük size minnettarız. ÇOK TEŞEKKÜRLER...

 

[evuye]

Aktarılan Veri Sayısı

Ömer Bey merhaba, yazdığınız makro çok işimize yaradı. Ancak üstteki satırdan alttaki sütunlara eklenecek veri sayısı çok arttı ve ben makro üzerinden bunu yapmaya çalıştım. Yazdığınız makroda "For i = 3 To 32" olan kısımda 32 rakamını 1200 yaptım ama olmadı. Orası en fazla 24'ü kabul etti. 254'ün üzerinde bir rakam yazdığımda "over flow" hatasını verdi. Sizden ricam ekteki dosyanın "Aylık Gerceklesmeler" sekmesinde de görebileceğiniz gibi 1500'e yakın bir sayıda veri aktarması yapmaya ihtiyacım var.

Bir de "Aylik Gerceklesmeler" sekmesinde satır gizleme, sütün genişliği değiştirme gibi işlemleri yapınca hata veriyor. "End" dedikten sonra tuşa tekrar basınca sorunsuz çalışıyor. Tabi makronun çalışmasında sorun olmadığı için bu durum elzem değil. Önemli olan 1500 adet verinin aktarılabilmesi.

Aslında şu anda 1000'e yakın bir veriye ihtiyacım var ama daha sonrasında da lazım olabilir düşüncesiyle mümkünse şimdiden 1500 kadar veriyi aktarma şansımız olursa iyi olur diye düşünüyorum.

Bu konuda da yardımcı olursanız çok seviniriz. Şimdiden teşekkür ederiz.

 

[Ömer]

Değişken tanımından kaynaklanıyordu. Byte değişken türü 0 ile 255 arasını kapsar. Bu yüzden hata aldınız.

Kodu yeniden düzenledim. Aşağıdaki haliyle i döngüsü 3. satırın son sütununa kadar işlem yapar. Ayrıca hücre genişliklerini kaldırdım.

Sub yapilan_isler_aktar()
 
    Dim tarih As Date, d As Range, i As Integer, sut As Integer
 
    Application.ScreenUpdating = False
    Sheets("Aylik Gerceklesmeler").Select
 
    tarih = DateSerial(Year(Date), Month(Date) - 1, 1)
 
    sut = WorksheetFunction.Match(CDbl(tarih), Rows(17), 0)
 
    For i = 3 To Cells(3, Columns.Count).End(xlToLeft).Column
        Set d = Range("C17:C" & _
            Rows.Count).Find(Cells(3, i), , xlValues, xlWhole)
        If Not d Is Nothing Then
            Cells(d.Row, sut) = Cells(4, i)
        End If
    Next i
 
End Sub

 

[evuye]

Ömer Bey, dosyayı açıp butona ilk tıklandığında sadece 99'a kadar aktarıyor. Sonrasında rakamların bulunduğu "c" sütununun genişliğini otomatik ayarlamak için sütunun üst kısmına çift tıkladığımda ("c" sütununu genişlettiğimde) tekrar tıklıyorum ve bu seferde 336'ya kadar yazıyor. Ben mi yanlış birşey yapıyorum anlayamadım.

 

[Ömer]

Bu şekilde deneyin.

Sub yapilan_isler_aktar()
 
    Dim tarih As Date, d As Range, i As Integer, sut As Integer
 
    Application.ScreenUpdating = False
    Sheets("Aylik Gerceklesmeler").Select
 
    [C:C].EntireColumn.AutoFit
    tarih = DateSerial(Year(Date), Month(Date) - 1, 1)
 
    sut = WorksheetFunction.Match(CDbl(tarih), Rows(17), 0)
 
    For i = 3 To Cells(3, Columns.Count).End(xlToLeft).Column
        Set d = Range("C17:C" & _
            Rows.Count).Find(Cells(3, i), , xlValues, xlWhole)
        If Not d Is Nothing Then
            Cells(d.Row, sut) = Cells(4, i)
        End If
    Next i
    
    Columns("C:C").ColumnWidth = 2.29
 
End Sub

.

 

[evuye]

Vallahi oldu. Ama nasıl oldu? Meraktan soruyorum. Sorun sütun genişliğinde miymiş?

Bu arada siz hangi ilde ikamet ediyorsunuz? İzmir'de iseniz bir eğitim programı filan organize edebilirsek verebilir misiniz? ücretine mukabil tabiki.

Son olarak desteğiniz için tekrar çok teşekkür ederiz.

 

[Ömer]

Rica ederim.

Evet genişlikle ilgili, önce genişlettim sonra eski haline çevirdim.
Find kullanmadan matc yöntemi ilede yapılabilir, fakat bu sefer fazladan hata kontrolü yapmam gerekir diye bu şekilde halletim.