İSME GÖRE DEĞER AKTARMA

Katılım
4 Temmuz 2011
Mesajlar
91
Excel Vers. ve Dili
Türkçe 2013
İyi günler göndermiş olduğum dosyada nöbet listesi 1 ve nöbet listesi 2 sayfalarından PUANTAj sayfasına isme tutuyorsa deger aktarıyor . kod sayfaları tarıyor puantajdakı isimler belirli sutunlarda ise 24 baska sutunlarda ise 8 degeri aktarıyor
ben bunu sutun aralıgında degilde isme göre nasıl yaparım yanı nöbet listesi 1 ve 2 de isim RIZA ise 24, Mehmet ise 8 hüseyın ise 12 ... gibi birden fazla sayfadan işlem yapılacak. şimdiden cok teşekür ederim.


DOSYA EK



Kod:
Sub aktar()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sayfa2.Range("M6:AQ17").ClearContents
For x = 1 To 31   ' sayfa 2 1 den 31 sutunlar
    For y = 10 To 16        'J=10, K=11, L=12, M=13. sütun
       If y > 13 Then  ' 13 sutundan sonrası ıcın deger 8
        deger = 8
       Else
        deger = 24  '13 sutundan sonrası ıcın deger 24
       End If
       tmp1 = Sayfa3.Cells(2 * x + 1, y)    'H3 H64 Arası 2  şer adımla ilerle
       If tmp1 = "" Then GoTo atla
       For Z = 6 To 17      ' Z Puantaj sayfası personel sayısı 6. satır 17. satır
            tmp2 = Sayfa2.Cells(Z, "K") ' Z puantajdakı K sutunu yazılacak
            If tmp1 = tmp2 Then  ' adımlamadakı deger ıle sayfa 2 dekı deger aynı ıse
                Sayfa2.Cells(Z, x + 12) = deger    'sayfa 2 dekı  12 sutun sonrasına yaz 1den 31 e  kadar yaz
                Exit For
            End If
       Next Z
atla:
       tmp1 = Sayfa3.Cells(2 * x + 2, y)    'H3 H61 Arası 2  şer adımla ilerle
       If tmp1 = "" Then GoTo atla2
       For Z = 6 To 17      'Puantaj sayfası personel sayısı 6. satır 17. satır
            tmp2 = Sayfa2.Cells(Z, "K")
            If tmp1 = tmp2 Then
                Sayfa2.Cells(Z, x + 12) = deger
                Exit For
            End If
       Next Z
atla2:

' BURDAN SONRA
tmp1 = Sayfa1.Cells(2 * x + 1, y)    'H3 H64 Arası 2  şer adımla ilerle
       If tmp1 = "" Then GoTo atla3
       For Z = 6 To 17      ' Z Puantaj sayfası personel sayısı 6. satır 17. satır
            tmp2 = Sayfa2.Cells(Z, "K") ' Z puantajdakı K sutunu yazılacak
            If tmp1 = tmp2 Then  ' adımlamadakı deger ıle sayfa 2 dekı deger aynı ıse
                Sayfa2.Cells(Z, x + 12) = deger    'sayfa 2 dekı  12 sutun sonrasına yaz 1den 31 e  kadar yaz
                Exit For
            End If
       Next Z
atla3:
       tmp1 = Sayfa1.Cells(2 * x + 2, y)    'H3 H61 Arası 2  şer adımla ilerle
       If tmp1 = "" Then GoTo atla4
       For Z = 6 To 17      'Puantaj sayfası personel sayısı 6. satır 17. satır
            tmp2 = Sayfa2.Cells(Z, "K")
            If tmp1 = tmp2 Then
                Sayfa2.Cells(Z, x + 12) = deger
                Exit For
            End If
       Next Z
atla4:

    Next y
Next x
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
 
Katılım
4 Temmuz 2011
Mesajlar
91
Excel Vers. ve Dili
Türkçe 2013
İyi günler göndermiş olduğum dosyada nöbet listesi 1 ve nöbet listesi 2 sayfalarından PUANTAj sayfasına isme tutuyorsa deger aktarıyor . kod sayfaları tarıyor puantajdakı isimler belirli sutunlarda ise 24 baska sutunlarda ise 8 degeri aktarıyor
ben bunu sutun aralıgında degilde isme göre nasıl yaparım yanı nöbet listesi 1 ve 2 de isim RIZA ise 24, Mehmet ise 8 hüseyın ise 12 ... gibi birden fazla sayfadan işlem yapılacak. şimdiden cok teşekür ederim.


DOSYA EK



Kod:
Sub aktar()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sayfa2.Range("M6:AQ17").ClearContents
For x = 1 To 31   ' sayfa 2 1 den 31 sutunlar
    For y = 10 To 16        'J=10, K=11, L=12, M=13. sütun
       If y > 13 Then  ' 13 sutundan sonrası ıcın deger 8
        deger = 8
       Else
        deger = 24  '13 sutundan sonrası ıcın deger 24
       End If
       tmp1 = Sayfa3.Cells(2 * x + 1, y)    'H3 H64 Arası 2  şer adımla ilerle
       If tmp1 = "" Then GoTo atla
       For Z = 6 To 17      ' Z Puantaj sayfası personel sayısı 6. satır 17. satır
            tmp2 = Sayfa2.Cells(Z, "K") ' Z puantajdakı K sutunu yazılacak
            If tmp1 = tmp2 Then  ' adımlamadakı deger ıle sayfa 2 dekı deger aynı ıse
                Sayfa2.Cells(Z, x + 12) = deger    'sayfa 2 dekı  12 sutun sonrasına yaz 1den 31 e  kadar yaz
                Exit For
            End If
       Next Z
atla:
       tmp1 = Sayfa3.Cells(2 * x + 2, y)    'H3 H61 Arası 2  şer adımla ilerle
       If tmp1 = "" Then GoTo atla2
       For Z = 6 To 17      'Puantaj sayfası personel sayısı 6. satır 17. satır
            tmp2 = Sayfa2.Cells(Z, "K")
            If tmp1 = tmp2 Then
                Sayfa2.Cells(Z, x + 12) = deger
                Exit For
            End If
       Next Z
atla2:

' BURDAN SONRA
tmp1 = Sayfa1.Cells(2 * x + 1, y)    'H3 H64 Arası 2  şer adımla ilerle
       If tmp1 = "" Then GoTo atla3
       For Z = 6 To 17      ' Z Puantaj sayfası personel sayısı 6. satır 17. satır
            tmp2 = Sayfa2.Cells(Z, "K") ' Z puantajdakı K sutunu yazılacak
            If tmp1 = tmp2 Then  ' adımlamadakı deger ıle sayfa 2 dekı deger aynı ıse
                Sayfa2.Cells(Z, x + 12) = deger    'sayfa 2 dekı  12 sutun sonrasına yaz 1den 31 e  kadar yaz
                Exit For
            End If
       Next Z
atla3:
       tmp1 = Sayfa1.Cells(2 * x + 2, y)    'H3 H61 Arası 2  şer adımla ilerle
       If tmp1 = "" Then GoTo atla4
       For Z = 6 To 17      'Puantaj sayfası personel sayısı 6. satır 17. satır
            tmp2 = Sayfa2.Cells(Z, "K")
            If tmp1 = tmp2 Then
                Sayfa2.Cells(Z, x + 12) = deger
                Exit For
            End If
       Next Z
atla4:

    Next y
Next x
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Bana yardım edecek bir arkadaşım yok mu
Lütfen yardımcı olabilirmisiniz??
 
Üst