veri çekme

[mest3651]

arkadaşlar yapmak istediğim şeyi dosyada anlatmaya çalıştım. yardımcı olacak arkadaşlara şimdiden çok teşekkür ediyorum.

 

[halit3]

arkadaşlar yapmak istediğim şeyi dosyada anlatmaya çalıştım. yardımcı olacak arkadaşlara şimdiden çok teşekkür ediyorum.

Sorunuzun kısa açıklamasını yapınız aksi taktirde sorunuzu öğrenmek için dosyanızı indirmek zorunda bırakmayınız. zira kota sorunları var.

ekli dosyanızı kontrol ediniz.

 

[mest3651]

halit hocam çok sağolun beni büyük bi yükten kurtardınız. bi sorum daha olacak aktar butonunu dosyada gösterdiğim yere alabilirmiyiz. çok teşekkürler saygılarımla.

 

[mest3651]

yeni şekliyle yüklüyorum. sağolun.

 

[halit3]

ekli dosyanızı kontrol ediniz.

 

[reels]

merhaba

Forumdaki uzman arkadaşların affına sığınarak, ekteki çözümü inceler misiniz?

 

[halit3]

Forumdaki uzman arkadaşların affına sığınarak, ekteki çözümü inceler misiniz?

Sayın reels:

Burası paylaşım sitesi farklılıklar ve alternatifler mutlaka olacaktır.
Onun için af dilemek gereksiz ben kendi namıma hiç alınmam çözümünüzde güzel olmuş.

Katılımınız için teşekkür ediyorum. İyi çalışmalar

 

[halit3]

5 nolu mesajdaki dosyada J ve K sutunundaki verileri yer değiştirdim.

 

[mest3651]

halit hocam verdiğiniz makroyu bu dosyaya bi türlü uyarlayamadım. yardımcı olursanız çok sevinirim. çok teşekkür ediyorum.

 

[halit3]

halit hocam verdiğiniz makroyu bu dosyaya bi türlü uyarlayamadım. yardımcı olursanız çok sevinirim. çok teşekkür ediyorum.

Dosyanı ben sildim çünkü kerçek bilgileriniz mevcuttu

Bu kod senin dosyanda çok yavaş çalışıyor ilgili iki sayfayı başka bir dosyaya aktardım ve kodu orada denedim baya hızlı çalışıyor.

Sub aktar()
sat = 2
Worksheets("KAYIT GÜNCELLEME").Range("j2:L65000").ClearContents
Worksheets("KAYIT GÜNCELLEME").Range("ac2:ac65000").ClearContents
son = Worksheets("sonuçlar").Cells(Rows.Count, "a").End(3).Row
For i = 1 To son
aranan = Worksheets("sonuçlar").Cells(i, 1).Value
If aranan <> "" Then
If WorksheetFunction.CountIf(Worksheets("sonuçlar").Range("A2:A" & i), aranan) = 1 Then
sat1 = 0
Set d = Worksheets("sonuçlar").Range("a2:a" & son).Find(aranan, LookIn:=xlValues)
If Not d Is Nothing Then
firstAddress = d.Address
Do
If Worksheets("sonuçlar").Cells(d.Row, "d").Value >= 70 Then
Worksheets("KAYIT GÜNCELLEME").Cells(sat, "k").Value = Worksheets("sonuçlar").Cells(d.Row, "d").Value
End If
If Worksheets("sonuçlar").Cells(d.Row, "e").Value >= 70 Then
Worksheets("KAYIT GÜNCELLEME").Cells(sat, "j").Value = Worksheets("sonuçlar").Cells(d.Row, "e").Value
End If
If Worksheets("sonuçlar").Cells(d.Row, "f").Value >= 70 Then
Worksheets("KAYIT GÜNCELLEME").Cells(sat, "l").Value = Worksheets("sonuçlar").Cells(d.Row, "f").Value
End If
Worksheets("KAYIT GÜNCELLEME").Cells(sat, "ac").Value = Worksheets("sonuçlar").Cells(d.Row, "a").Value
sat1 = 1
Set d = Worksheets("sonuçlar").Range("a2:a" & son).FindNext(d)
Loop While Not d Is Nothing And d.Address <> firstAddress
End If
End If
End If
If sat1 = 1 Then
sat = sat + 1
End If
Next i
MsgBox "işlem tamam"
End Sub

 

[halit3]

Dosyanızdaki T.C. Kimlik numaralarını değiştirdim birde kayıt güncelleme sayfasını sildim yeniden oluşturdum kod şimdi hızlı çalışıyor.

 

[mest3651]

halit hocam ilginiz için çok teşekkür ederim. kendi dosyamda çalıştırdığımda t.c kimlik numaralarını siliyor sonuçlar sayfasındaki ilk tc numarasından itibaren sonuçları getiriyor. fazla formül kullanmamdan dolayı olbilirmi.

 

[halit3]

halit hocam ilginiz için çok teşekkür ederim. kendi dosyamda çalıştırdığımda t.c kimlik numaralarını siliyor sonuçlar sayfasındaki ilk tc numarasından itibaren sonuçları getiriyor. fazla formül kullanmamdan dolayı olbilirmi.

Evet söylediğiniz gibi dosyanızda çok fazla formül var kullanılmıyan alanlarda bile formüller veya veriler mevcut

 

[denedim]

lütfen acil yardım

Arkadaşlar merhabalar. benim sorunum evrak kayıt konusunda.
hem gelen hemde giden evrak kaydı yapmam gerekiyor, hem de dosya dizin yapmam gerekiyor. Benim istediğim gelen evrakları gelen evrak sayfasına yazarken ilgili dosya dizini sayfasına da aynı anda yazmak istiyorum lütfen yardım ediniz.şimdiden teşekkurler