Skip to main content

AccessTr.neT

Kayıt Ol

 | Facebook ile Bağlan  | Twitter İle Bağlan | Google+ İle Bağlan

Şartlı Veri Aktarmak

m_demir
m_demir
Excel Cevaplanmış Soruları
4
272

Şartlı Veri Aktarmak

Çözüldü #1
m_demir
Aktif Üye
m_demir
Bul
Aktif Üye
Adı Soyadı: De.... Yı....
Yaşı: 63
Konum: -
Ofis Versiyonu: Ofis 2010 64 Bit
Son Oturumu: 02/07/2021,00:34
Yorumları: 620
Konuları: 122
Kayıt Tarihi: 03/06/2016
Rep Puanı: 0
Mesleğiniz: Grafiker
Merhaba Arkadaşlar

Eklediğim uygulamada L1 Hücresine yazdığım rakama göre aktarma yapsın.

Örneğin L1 1 yazdığım zaman
Ocak Ayına aktarma yapsın
A2 deki veriyi Ocak ayına Q4 e aktarsın
B2 deki veriyi Ocak ayına R4 e aktarsın
D2 deki veriyi Ocak ayına S4 e aktarsın
F2 deki veriyi Ocak ayına U4 e aktarsın
G2 deki veriyi Ocak ayına V4 e aktarsın
H2 deki veriyi Ocak ayına W4 e aktarsın

L1 E 2 yazdığımız zaman şubat ayına aktarsın
.rar Gelir-Gider.rar (Dosya Boyutu: 4,67 MB | İndirme Sayısı: 6)
Cevapla
#2
userx
Uzman
userx
Bul
Uzman
Adı Soyadı:
Yaşı: 39
Konum: -
Ofis Versiyonu: -
Yorumları: 376
Konuları: 2
Kayıt Tarihi: 24/08/2009
Rep Puanı: 110
Sayın m_demir

Aktar butonuna aşağıdaki kodu yazarak dener misiniz?
Visual Basic Code 
With ThisWorkbook.Sheets("Sayfa1")
 Dim i As Long
  i = .Range("L1") + 3
        .Range("Q" & i & ":" & "R" & i).Value = .Range("A2:C2").Value
        .Range("U" & i & ":" & "V" & i).Value = .Range("F2:G2").Value
        .Range("S" & i).Value = .Range("Q" & i).Value - Range("R" & i).Value
        .Range("W" & i).Value = .Range("U" & i).Value - Range("V" & i).Value
    End With
    MsgBox "İşlem Tamamlandı"
"Dünyayı fazla düşünme."
Cevapla
#3
m_demir
Aktif Üye
m_demir
Bul
Aktif Üye
Adı Soyadı: De.... Yı....
Yaşı: 63
Konum: -
Ofis Versiyonu: Ofis 2010 64 Bit
Son Oturumu: 02/07/2021,00:34
Yorumları: 620
Konuları: 122
Kayıt Tarihi: 03/06/2016
Rep Puanı: 0
Mesleğiniz: Grafiker
Çok teşekkürler Hocam ellerinize sağlık tam istediğim gibi olmuş.

*Hocam L1 hücresi boş olduğu zaman uyarı verse çok iyi olur.

*Aktarılacak Hücreler dolu ise Daha önce aktarma yarılmış, verileri değiştirmek istiyormusunuz evet hayıt onayı istesin.
Cevapla
#4
userx
Uzman
userx
Bul
Uzman
Adı Soyadı:
Yaşı: 39
Konum: -
Ofis Versiyonu: -
Yorumları: 376
Konuları: 2
Kayıt Tarihi: 24/08/2009
Rep Puanı: 110
Visual Basic Code 
Sub Aktar()
If Range("L1") = "" Or Range("L1") > 12 Then
 MsgBox "L1 Alanına geçerli bir değer girmediniz."
    Else
 With ThisWorkbook.Sheets("Sayfa1")
 Dim i As Long
 
  i = .Range("L1") + 3
    If Range("Q" & i).Value = "" Then
        .Range("Q" & i & ":" & "R" & i).Value = .Range("A2:C2").Value
        .Range("U" & i & ":" & "V" & i).Value = .Range("F2:G2").Value
        .Range("S" & i).Value = .Range("Q" & i).Value - Range("R" & i).Value
        .Range("W" & i).Value = .Range("U" & i).Value - Range("V" & i).Value
    Else
    
    If MsgBox("Kaydetmek istediğiniz alanda kayıt var. Değişiklik yapılsın mı?", vbCritical + vbYesNo + vbDefaultButton1, "UYARI") = vbNo Then Exit Sub
      .Range("Q" & i & ":" & "R" & i).Value = .Range("A2:C2").Value
        .Range("U" & i & ":" & "V" & i).Value = .Range("F2:G2").Value
        .Range("S" & i).Value = .Range("Q" & i).Value - Range("R" & i).Value
        .Range("W" & i).Value = .Range("U" & i).Value - Range("V" & i).Value
      End If
      
End With
        MsgBox "İşlem Tamamlandı"
    End If
End Sub

Üstteki kodu dener misin?
"Dünyayı fazla düşünme."
Son Düzenleme: 02/02/2021, 21:16, Düzenleyen: userx. (Sebep: Değişiklik)
Cevapla
#5
m_demir
Aktif Üye
m_demir
Bul
Aktif Üye
Adı Soyadı: De.... Yı....
Yaşı: 63
Konum: -
Ofis Versiyonu: Ofis 2010 64 Bit
Son Oturumu: 02/07/2021,00:34
Yorumları: 620
Konuları: 122
Kayıt Tarihi: 03/06/2016
Rep Puanı: 0
Mesleğiniz: Grafiker
Çok, çok teşekkürler Hocam ellerinize sağlık. Tam istediğim gibi olmuş.

Hocam konuyu taşıtabilirsiniz saygılarımla sağlıklı günler diliyorum.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da