• DİKKAT

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

Activecell.offset İle Yazdırma Sorunu

ahmed_ummu

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
777
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Merhaba arkadaşlar.

Aktif sayfadaki r21, s21, t21, u21, v21 hücrelerindeki verileri Sayfa1 sayfasındaki seçili hücrenin 54... sağına yazmak istiyorum. Aşağıdaki kod ile sayfa1 sayfasındaki p12 hücresindeki ismi seçiyo ama seçşli hücrenin 54 sağına yazmıyor. Bir sorun görünmüyo ama yazmıyor. Hata da vermiyor

Private Sub CommandButton2_Click()

gunduz1 = Range("r21").Value
gunduz2 = Range("s21").Value
gunduz3 = Range("t21").Value
gunduz4 = Range("u21").Value
gunduz5 = Range("v21").Value
suz = Range("p12").Value

On Error Resume Next

Sheets("sayfa1").Select
For sut = 45 To [b65000].End(xlUp).Row
If Range("b" & sut) Like suz Then
Range("b" & sut).Select 'Buraya kadar çalışıyor. Alttaki kodların işlevini yapmıyor.

ActiveCell.Offset(0, 54).Value = gunduz1
ActiveCell.Offset(0, 55).Value = gunduz2
ActiveCell.Offset(0, 56).Value = gunduz3
ActiveCell.Offset(0, 57).Value = gunduz4
ActiveCell.Offset(0, 58).Value = gunduz5
End If
Next sut
End Sub
 
Merhaba.
On Error Resume Next satırını silin, hangi satırda hata verdiğini ve hata mesajını söyleyin.
 
Hata varsa ve gördükten sonra kodlarınızı SELECT kullanamdan aşağıdkai gibi yazabilirsiniz.
C++: 
If Range("b" & sut) Like suz Then
    For x=54 to 58
        Range("b" & sut).Offset(0, x).Value = gunduz1
    Next x
End if
 
ÖmerFaruk' Alıntı:
Hata varsa ve gördükten sonra kodlarınızı SELECT kullanamdan aşağıdkai gibi yazabilirsiniz.
C++: 
If Range("b" & sut) Like suz Then
    For x=54 to 58
        Range("b" & sut).Offset(0, x).Value = gunduz1
    Next x
End if
Genişletmek için tıkla ...

Teşekkürler Ömer Faruk bey.
Aşağıdaki gibi yaptım gönderdiğiniz kodları ama yine yazmadı.

Private Sub CommandButton2_Click()

gunduz1 = Range("r21").Value
gunduz2 = Range("s21").Value
gunduz3 = Range("t21").Value
gunduz4 = Range("u21").Value
gunduz5 = Range("v21").Value
suz = Range("p12").Value

On Error Resume Next

Sheets("sayfa1").Select
For sut = 45 To [b65000].End(xlUp).Row
If Range("b" & sut) Like suz Then
Range("b" & sut).Select

If Range("b" & sut) Like suz Then
For x = 54 To 58
Range("b" & sut).Offset(0, x).Value = gunduz1
Next x
End If

End If
Next sut
'Sheets ("ücret giriş")
 
@Muzaffer Ali beyin dediğini yaptınız mı?
Eğer yapamıyor ya da bulamıyorsanız dosyanızı biizmle paylaşabilirsiniz.
 
Ali beyin dediği gibi yaptım ama hata vermiyor. Dosyayı linkini verdim.
EKDERS GİRİŞ sayfasında yapılacak işlemler

İndir VERİ TABANI

Dosyayı indir VERİ TABANI
dosya.co
 
Farklı bir sayfaya aktarmak istediğinizden olmuyor.
Kodları revize ettim deneyiniz.

Kod: 
Private Sub CommandButton2_Click()
    Dim Suz As Variant
    Dim Sut As Integer
    Suz = Range("p12").Value
    With Sheets("sayfa1")
        For sut = 45 To .Cells(Rows.Count, "B").End(xlUp).Row
            If .Range("b" & sut) Like Suz Then
                .Cells(sut, 56) = Range("r21").Value
                .Cells(sut, 57) = Range("s21").Value
                .Cells(sut, 58) = Range("t21").Value
                .Cells(sut, 59) = Range("r21").Value
                .Cells(sut, 60) = Range("v21").Value
            End If
        Next sut
    End With
End Sub
 
Muzaffer Ali' Alıntı:
Farklı bir sayfaya aktarmak istediğinizden olmuyor.
Kodları revize ettim deneyiniz.

Kod: 
Private Sub CommandButton2_Click()
    Dim Suz As Variant
    Dim Sut As Integer
    Suz = Range("p12").Value
    With Sheets("sayfa1")
        For sut = 45 To .Cells(Rows.Count, "B").End(xlUp).Row
            If .Range("b" & sut) Like Suz Then
                .Cells(sut, 56) = Range("r21").Value
                .Cells(sut, 57) = Range("s21").Value
                .Cells(sut, 58) = Range("t21").Value
                .Cells(sut, 59) = Range("r21").Value
                .Cells(sut, 60) = Range("v21").Value
            End If
        Next sut
    End With
End Sub
Genişletmek için tıkla ...

Çok teşekkürler sorunsuz çalışıyor.
 
Yazmışken alternatif olsun.
C++: 
Private Sub CommandButton2_Click()
Dim Alan As Range, Bul As Range, x As Integer
With Sheets("Sayfa1")
    Set Alan = .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row)
    Set Bul = Alan.Find(Range("p12").Value, , xlValues, xlWhole)
    If Bul Is Nothing Then MsgBox "Öğretmen bulunamadı": Exit Sub
    For x = 54 To 58
        Bul.Offset(0, x) = Cells(21, 18 + x - 54)
    Next x
    MsgBox "İşlem tamamlandı."
End With
End Sub
 
Merhaba arkadaşlar.

Muzaffer Ali beyin gönderdiği Aşağıdaki kod ile "Ekders Giriş" sayfasındaki kodlarda görülen hücre değerlerini "Sayfa1" sayfasındaki hücrelere yazdırdım. Şimdi ise tam tersini yapmak istiyorum. Kırmızı kod bloğunun tam tersini yapmak istiyorum. "Sayfa1" sayfasındaki verileri "Ekders Giriş" sayfasına aldırmak istiyorum. Birkaç deneme yaptım ama olmadı. Yardımcı olursanız sevinirim.

Dim Suz As Variant
Dim Sut As Integer
Suz = Range("p12").Value
With Sheets("sayfa1")
For Sut = 45 To .Cells(Rows.Count, "B").End(xlUp).Row
If .Range("b" & Sut) Like Suz Then
.Cells(Sut, 56) = Range("P21").Value
.Cells(Sut, 57) = Range("Q21").Value
.Cells(Sut, 58) = Range("R21").Value
.Cells(Sut, 59) = Range("S21").Value
.Cells(Sut, 60) = Range("T21").Value
.Cells(Sut, 61) = Range("W21").Value
.Cells(Sut, 62) = Range("AG21").Value
End If
Next Sut
End With
 
= işaretinin sağındakini sola soldakini sağa alın.
Kod: 
.Cells(Sut, 56) = Range("P21").Value
Aşağıdaki gibi olacak.
Kod: 
Range("P21").Value = .Cells(Sut, 56)
diğer satırları da siz yaparsınız.
 
Muzaffer Ali' Alıntı:
= işaretinin sağındakini sola soldakini sağa alın.
Kod: 
.Cells(Sut, 56) = Range("P21").Value
Aşağıdaki gibi olacak.
Kod: 
Range("P21").Value = .Cells(Sut, 56)
diğer satırları da siz yaparsınız.
Genişletmek için tıkla ...

Teşekkürler Muzaffer Ali bey. Aynısını yaptım ama olmadı hiç birşey yazmadı.

Aşağıdaki gibi yaptım ama böyle uzun kod yazmak gerekecek.

Sheets("sayfa1").Select
On Error Resume Next
For Sut = 45 To [b65000].End(xlUp).Row
If Range("b" & Sut) Like ListBox1.Text Then
Range("b" & Sut).Select
adi = ActiveCell.Offset(0, 0)
bransi = ActiveCell.Offset(0, 9)

gunduz1 = ActiveCell.Offset(0, 54).Value
gunduz2 = ActiveCell.Offset(0, 55).Value
gunduz3 = ActiveCell.Offset(0, 56).Value
gunduz4 = ActiveCell.Offset(0, 57).Value
gunduz5 = ActiveCell.Offset(0, 58).Value
gunduz6 = ActiveCell.Offset(0, 59).Value
gunduz7 = ActiveCell.Offset(0, 60).Value

Sheets("ekders giriş").Select
Sheets("ekders giriş").Range("p12").Value = adi
Sheets("ekders giriş").Range("p13").Value = bransi

Sheets("ekders giriş").Range("p21").Value = gunduz1
Sheets("ekders giriş").Range("q21").Value = gunduz2
Sheets("ekders giriş").Range("r21").Value = gunduz3
Sheets("ekders giriş").Range("s21").Value = gunduz4
Sheets("ekders giriş").Range("t21").Value = gunduz5
Sheets("ekders giriş").Range("w21").Value = gunduz6
Sheets("ekders giriş").Range("ag21").Value = gunduz7


End If
Next Sut

Daha kısa olması için yardımcı olursanız sevinirim.
 
Kod: 
gunduz1 = ActiveCell.Offset(0, 54).Value
Gibi olan satırlara gerek yok.

Kod: 
Sheets("ekders giriş").Range("p21").Value = ActiveCell.Offset(0, 54).Value

şeklinde yapın.
Yani "gunduz", "adi" ve "bransi" değişkenlerini kullanmadan direk yazın.


Sheets("ekders giriş").Select satırını silin.
 
Muzaffer Ali' Alıntı:
Kod: 
gunduz1 = ActiveCell.Offset(0, 54).Value
Gibi olan satırlara gerek yok.

Kod: 
Sheets("ekders giriş").Range("p21").Value = ActiveCell.Offset(0, 54).Value

şeklinde yapın.
Yani "gunduz", "adi" ve "bransi" değişkenlerini kullanmadan direk yazın.


Sheets("ekders giriş").Select satırını silin.
Genişletmek için tıkla ...

Aşağıdaki gibi yaptım ama yine olmadı. Sayfa1 sayfasına gelip adı seçili olan kişinin ismine konumlanıyo imleç

Sheets("sayfa1").Select
On Error Resume Next
For Sut = 45 To [b65000].End(xlUp).Row
If Range("b" & Sut) Like ListBox1.Text Then
Range("b" & Sut).Select

Sheets("ekders giriş").Range("p12").Value = ActiveCell.Offset(0, 0).Value
Sheets("ekders giriş").Range("p13").Value = ActiveCell.Offset(0, 9).Value
Sheets("ekders giriş").Range("p21").Value = ActiveCell.Offset(0, 54).Value
Sheets("ekders giriş").Range("q21").Value = ActiveCell.Offset(0, 54).Value
Sheets("ekders giriş").Range("r21").Value = ActiveCell.Offset(0, 54).Value
Sheets("ekders giriş").Range("s21").Value = ActiveCell.Offset(0, 54).Value
Sheets("ekders giriş").Range("t21").Value = ActiveCell.Offset(0, 54).Value
Sheets("ekders giriş").Range("w21").Value = ActiveCell.Offset(0, 54).Value
Sheets("ekders giriş").Range("ag21").Value = ActiveCell.Offset(0, 54).Value

End If
Next Sut
 
İlk verdiğim kod.

Kod: 
Private Sub CommandButton2_Click()
    Dim Suz As Variant
    Dim Sut As Integer
    Suz = Range("p12").Value
    With Sheets("sayfa1")
        For sut = 45 To .Cells(Rows.Count, "B").End(xlUp).Row
            If .Range("b" & sut) Like Suz Then
                .Cells(sut, 56) = Range("r21").Value
                .Cells(sut, 57) = Range("s21").Value
                .Cells(sut, 58) = Range("t21").Value
                .Cells(sut, 59) = Range("r21").Value
                .Cells(sut, 60) = Range("v21").Value
            End If
        Next sut
    End With
End Sub

Verilerin terse gelmesini istiyorsanız hücre adreslerinin yerini değiştirin.
Örnek.
Kod: 
 .Cells(sut, 56) = Range("r21").Value
Satırını aşağıdaki gibi = işaretinin sağındakini sola soldakini sağa yazın.
Kod: 
 Range("r21").Value = .Cells(sut, 56)
 
Muzaffer Ali' Alıntı:
İlk verdiğim kod.

Kod: 
Private Sub CommandButton2_Click()
    Dim Suz As Variant
    Dim Sut As Integer
    Suz = Range("p12").Value
    With Sheets("sayfa1")
        For sut = 45 To .Cells(Rows.Count, "B").End(xlUp).Row
            If .Range("b" & sut) Like Suz Then
                .Cells(sut, 56) = Range("r21").Value
                .Cells(sut, 57) = Range("s21").Value
                .Cells(sut, 58) = Range("t21").Value
                .Cells(sut, 59) = Range("r21").Value
                .Cells(sut, 60) = Range("v21").Value
            End If
        Next sut
    End With
End Sub

Verilerin terse gelmesini istiyorsanız hücre adreslerinin yerini değiştirin.
Örnek.
Kod: 
 .Cells(sut, 56) = Range("r21").Value
Satırını aşağıdaki gibi = işaretinin sağındakini sola soldakini sağa yazın.
Kod: 
 Range("r21").Value = .Cells(sut, 56)
Genişletmek için tıkla ...

Dim Suz As Variant
Dim Sut As Integer
Suz = Range("p12").Value
With Sheets("sayfa1") Bu satırda değişiklik olacak mı. İlk verdiğiniz kod da Ekders giriş sayfasından SAyfa1 sayfasına yazdırmıştık. Şimdi ise Sayfa1
sayfasından, Ekders giriş sayfasına yazdıracağız.
For sut = 45 To .Cells(Rows.Count, "B").End(xlUp).Row
If .Range("b" & sut) Like Suz Then
.Cells(sut, 56) = Range("r21").Value
.Cells(sut, 57) = Range("s21").Value
.Cells(sut, 58) = Range("t21").Value
.Cells(sut, 59) = Range("r21").Value
.Cells(sut, 60) = Range("v21").Value
End If
Next sut
End With
 
Kodlar eğer Sayfa1'in kod kısmında olacaksa aşağıdaki kodları kullanın.
Kod: 
Private Sub CommandButton2_Click()
    Dim Suz As Variant
    Dim Sut As Integer
    Suz = Range("p12").Value
    With Sheets("sayfa1")
        For sut = 45 To .Cells(Rows.Count, "B").End(xlUp).Row
            If .Range("b" & sut) Like Suz Then
                Range("r21").Value = .Cells(sut, 56)
                Range("s21").Value = .Cells(sut, 57)
                Range("t21").Value = .Cells(sut, 58)
                Range("r21").Value = .Cells(sut, 59)
                Range("v21").Value = .Cells(sut, 60)
            End If
        Next sut
    End With
End Sub

Eğer kodlar Ekders sayfasında olacaksa aşağıdaki kodları kullanın.
Kod: 
Private Sub CommandButton2_Click()
    Dim Suz As Variant
    Dim Sut As Integer
    Suz = Range("p12").Value
    With Sheets("Ekders")
        For sut = 45 To .Cells(Rows.Count, "B").End(xlUp).Row
            If .Range("b" & sut) Like Suz Then
                .Cells(sut, 56) = Range("r21").Value
                .Cells(sut, 57) = Range("s21").Value
                .Cells(sut, 58) = Range("t21").Value
                .Cells(sut, 59) = Range("r21").Value
                .Cells(sut, 60) = Range("v21").Value
            End If
        Next sut
    End With
End Sub
 
Son düzenleme:
Muzaffer Ali' Alıntı:
Kodlar eğer Sayfa1'in kod kısmında olacaksa son verdiğim kod olacak
Eğer kodlar Ekders sayfasında olacaksa kodlarda bulunan With Sheets("sayfa1") satırını With Sheets("Ekders") yapın
Genişletmek için tıkla ...

Çok teşekkürler. İşyerinin bilgisayarında çalışıyorum. Okul kapanıyo şu an yarın denerim. İyi akşamlar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst