• DİKKAT

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

sayfalar arası aktarma

  • Konbuyu başlatan Konbuyu başlatan Barons
  • Başlangıç tarihi Başlangıç tarihi

Barons

Altın Üye
Katılım
14 Mayıs 2005
Mesajlar
967
Excel Vers. ve Dili
Microsoft Ofis 365
merhaba

ekli dosyada sayfa 2'de X değerleri var ve bunların karşılıklarıda sayfa 4'te.Bir kod yardımıyla bu X değerlerinin karşılık olan harflerini sayfa2'ye monte etmek mümkünmüdür?
 

Ekli dosyalar

  • tp.xls
    tp.xls
    42 KB · Görüntüleme: 22
düşeyara fonksiyonunu kullanınız
 
merhaba

ekli dosyada sayfa 2'de X değerleri var ve bunların karşılıklarıda sayfa 4'te.Bir kod yardımıyla bu X değerlerinin karşılık olan harflerini sayfa2'ye monte etmek mümkünmüdür?

senin sorunun 1. kısmını yanıtlamıştım 2. kısmını analayamamıştım
anı soru sorduğun başlık içinde sarunu izihda bulunsaydın çözüm herhalde daha hızlı alırdınız

bu kodu bir denermisiniz.

Kod:
Sub aktar()
For i = 2 To WorksheetFunction.CountA(Worksheets("2").Range("ı2:ı65000")) + 2
For n = 2 To WorksheetFunction.CountA(Worksheets("4").Range("b2:b65000")) + 2
If Worksheets("4").Cells(n, 2).Value = Worksheets("2").Cells(i, 17).Value Then
Worksheets("2").Cells(i, 9).Value = Worksheets("4").Cells(n, 3).Value
End If
Next
Next
For i = 2 To WorksheetFunction.CountA(Worksheets("2").Range("v2:v65000")) + 2
For n = 2 To WorksheetFunction.CountA(Worksheets("4").Range("b2:b65000")) + 2
If Worksheets("4").Cells(n, 2).Value = Worksheets("2").Cells(i, 30).Value Then
Worksheets("2").Cells(i, 22).Value = Worksheets("4").Cells(n, 3).Value
End If
Next
Next
End Sub
 
Sn.Halit ..elinize sağlık...çok teşekkürler..istediğimde tam buydu.
 
Sn.Halit3
Birşey farkettim...dosyayı tekrar yolluyorum.
sayfa2 deki sizin önerdiğiniz AKTAR 1 düğmesindeki kod sorunsuz çalışıyor ancak sayfa 4 teki AKTAR 2 düğmesindeki kod aktarma yapıyor fakat aynı değerden 2 tane varsa ; örneğin
Q2 ve AD2 deki 3.92 gibi.
sayfa 4 te 3.92 değeri karşılığı A ise her ikiside A oluyor.
Dosyada ne demek istediğim daha iyi anlaşılır.örnekte V2 değeri B iken Aktar2 tıklanınca tekrar A oluyor.
 

Ekli dosyalar

  • tp.xls
    tp.xls
    49.5 KB · Görüntüleme: 22
bu kodu denermisin

Sub Düğme251_Tıklat()
For i = 2 To WorksheetFunction.CountA(Worksheets("2").Range("ı2:ı65000")) + 2
If Worksheets("2").Cells(i, 9).Value = "X" Then
For n = 2 To WorksheetFunction.CountA(Worksheets("4").Range("b2:b65000")) + 2
If Worksheets("4").Cells(n, 2).Value = Worksheets("2").Cells(i, 17).Value Then
MsgBox 1
Worksheets("2").Cells(i, 9).Value = Worksheets("4").Cells(n, 3).Value
End If
Next
End If
Next
For i = 2 To WorksheetFunction.CountA(Worksheets("2").Range("v2:v65000")) + 2
If Worksheets("2").Cells(i, 22).Value = "X" Then
For n = 2 To WorksheetFunction.CountA(Worksheets("4").Range("b2:b65000")) + 2
If Worksheets("4").Cells(n, 2).Value = Worksheets("2").Cells(i, 30).Value Then
Worksheets("2").Cells(i, 22).Value = Worksheets("4").Cells(n, 3).Value
End If
Next
End If
Next
End Sub
 
Süper...elinize sağlık...çok çok teşekkürler
 
Sn.Halit3
bastan itibaren yardımlarınız sebebiyle direk sizin adınızı verdim.
dosyada küçük bir ek yapmak gerekli oldu.açıklama dosyada mevcuttur.

tekrar yardımlarınız için teşekkürler
 

Ekli dosyalar

  • tp.xls
    tp.xls
    59 KB · Görüntüleme: 21
yardımlarınızı bekliyorum.
 
Sn.Halit3
bastan itibaren yardımlarınız sebebiyle direk sizin adınızı verdim.
dosyada küçük bir ek yapmak gerekli oldu.açıklama dosyada mevcuttur.

tekrar yardımlarınız için teşekkürler

bu kodu denermisiniz.

Kod:
Sub aktar5()
For i = 2 To WorksheetFunction.CountA(Worksheets("2").Range("ı2 :ı65000")) + 2
If Worksheets("2").Cells(i, 9).Value = "X" Then
For n = 2 To WorksheetFunction.CountA(Worksheets("5").Range("H2 :H65000")) + 2
If Worksheets("5").Cells(n, 8).Value = Worksheets("2").Cells(i, 17).Value Then
'MsgBox 1
Worksheets("5").Cells(n, 6).Value = Worksheets("2").Cells(i, 6).Value
End If
Next
End If
Next
For i = 2 To WorksheetFunction.CountA(Worksheets("2").Range("v2 :v65000")) + 2
If Worksheets("2").Cells(i, 22).Value = "X" Then
For n = 2 To WorksheetFunction.CountA(Worksheets("5").Range("H2 :H65000")) + 2
If Worksheets("5").Cells(n, 8).Value = Worksheets("2").Cells(i, 30).Value Then
Worksheets("5").Cells(n, 6).Value = Worksheets("2").Cells(i, 6).Value
End If
Next
End If
Next
MsgBox "Aktarım tamamlanmıştır."
End Sub
 
Mükemmel...çok çok teşekkürler...çok minnete geçti...duacınızım
 
Geri
Üst