• DİKKAT

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

Aynı sayfa içinde. Belirli kriterlere göre veri aktarımı.

  • Konbuyu başlatan Konbuyu başlatan ahzola
  • Başlangıç tarihi Başlangıç tarihi
A

ahzola

Katılım
17 Ekim 2011
Mesajlar
490
Excel Vers. ve Dili
Excel 2003 - Türkçe
Merhabalar

D2 hücresinde sabit 1 tane (içeriği değişken)
B ve C sütununda
Eşit sayıda olmak kaydı ile 10 ar 20 şer 30 ar gibi
(İçeriği Değişken) Verilerimiz olacak.

B C ve D sütunundaki verileri
E sütununda belirttiğim izahatlar doğrultusunda
G sütununda ki ""(Çift tırnak) ların içerisine aktaracağız.

D de tek bir veri olacak
B ve C deki verileri örnek olması için 3 adet belirledim.
Sizin yazacağınız makro doğrultusunda kendim
makroyu genişleteceğim.

Değerli Uzmanlarımızın alakalarını bekliyorum.
Saygılarımla.

Hangi veri Hangi hücreye

B2 deki veriyi G7 de ""(Tırnak içinde) olan değeri sil yerine yaz.
B2 deki veriyi G10 da ""(Tırnak içinde) olan değeri sil yerine yaz.

B3 deki veriyi G13 de ""(Tırnak içinde) olan değeri sil yerine yaz.
B3 deki veriyi G16 da ""(Tırnak içinde) olan değeri sil yerine yaz.

B4 deki veriyi G19 da ""(Tırnak içinde) olan değeri sil yerine yaz.
B4 deki veriyi G22 de ""(Tırnak içinde) olan değeri sil yerine yaz.

B5 deki veriyi G25 de ""(Tırnak içinde) olan değeri sil yerine yaz.
B5 deki veriyi G28 de ""(Tırnak içinde) olan değeri sil yerine yaz.

C2 deki veriyi G6 da ""(Tırnak içinde) olan değeri sil yerine yaz.
C2 deki veriyi G9 da ""(Tırnak içinde) olan değeri sil yerine yaz.

C3 deki veriyi G12 de ""(Tırnak içinde) olan değeri sil yerine yaz.
C3 deki veriyi G15 de ""(Tırnak içinde) olan değeri sil yerine yaz.

C4 deki veriyi G18 de ""(Tırnak içinde) olan değeri sil yerine yaz.
C4 deki veriyi G21 de ""(Tırnak içinde) olan değeri sil yerine yaz.

C5 deki veriyi G24 de ""(Tırnak içinde) olan değeri sil yerine yaz.
C5 deki veriyi G27 de ""(Tırnak içinde) olan değeri sil yerine yaz.

D2 deki veriyi G6 da ""(Tırnak içinde) olan değerin SOLUNA yaz.
D2 deki veriyi G9 da ""(Tırnak içinde) olan değerin SAĞINA yaz.

D2 deki veriyi G12 de ""(Tırnak içinde) olan değerin SOLUNA yaz.
D2 deki veriyi G15 de ""(Tırnak içinde) olan değerin SAĞINA yaz.

D2 deki veriyi G18 de ""(Tırnak içinde) olan değerin SOLUNA yaz.
D2 deki veriyi G21 de ""(Tırnak içinde) olan değerin SAĞINA yaz.

D2 deki veriyi G24 de ""(Tırnak içinde) olan değerin SOLUNA yaz.
D2 deki veriyi G27 de ""(Tırnak içinde) olan değerin SAĞINA yaz.
 

Ekli dosyalar

bu konu için mesaj atmışsınız ama iş yoğunluğum nedeni ile şu anda ilgilenme imkanım yok.
hafta sonu bir fırsat bulur isem ilgilenir çözüp çözemeyeceğimi yazarım.
bu arada bir arkadaş cevap vermiş olur belki.
 
dosya ektedir.

ancak benim çalışmam tırnak içindeki ifadeleri silerek yerine B, C, D sütundarındaki verileri yazmak şeklinde değildir.

örnek dosyadaki H sütununda verilen sonuçlara baktığımda;

Grup:"C sütunu, Sabit"
Rumuz"B Sütunu"
Onay: evet
Grup:"Sabit, C Sütunu"
Rumuz"B Sütunu"
Onay: evet

şeklinde, 6 satırda bir kendini tekrar eden bir döngü gördüm. bunun içinde yukarıda kırmızı yaptığım değerler sabit verilerdi.

dolayısıyla bu sabit değerleri VBA sabitine atayarak koda bunları tekrara yazdırmasını sağladım.

Eğer gerçek dosyada bu Grup, Rumuz, Onay: evet ifadeleri yer almayacaksa kod arzu edilen sonucu üretmez. ama desen bu ise ihtiyacı görecektir.

Kod: 
Sub Veri_Aktar()

    Dim ws As Worksheet
    Dim sbt As String
    
    Const grp As String = "Grup:"""
    Const rmz As String = "Rumuz:"""
    Const ony As String = "Onay: evet"
    Const tt As String = """"

    Set ws = Worksheets("Sayfa1")
    With ws
        sbt = .Range("D2").Value
        .Range("G6:G" & Rows.Count).Clear ' G6'dan en alta kadar eski verileri sil
        For i = 2 To .Range("B" & Rows.Count).End(xlUp).Row
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = grp & .Cells(i, "C") & sbt & tt
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = rmz & .Cells(i, "B") & tt
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = ony
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = grp & sbt & .Cells(i, "C") & tt
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = rmz & .Cells(i, "B") & tt
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = ony
        Next
    End With
    
End Sub
 

Ekli dosyalar

Sayın mancubus
Alakanız için çok teşekkür ederim

Yazmaya 6. satırdan itibaren başlasın istiyorum
nereyi değiştirmeliyim acaba.
Ona göre daha sağlıklı tesbit yapabileceğim.
 
mevcut durumda G5'e "Sonuçlar" diye bir ifade ekledim. bu nedenle G6'dan başlıyor yazmaya.

eğer bu ifadeyi silersek G2'den başlar. bu nedenle oraya bir şey yazabilirsiniz.
 
veya kendisi yazsın... ve işi bitince silsin.
koda kırmızı satırları ilave ettim.

Kod: 
Sub Veri_Aktar()

    Dim ws As Worksheet
    Dim sbt As String
    
    Const grp As String = "Grup:"""
    Const rmz As String = "Rumuz:"""
    Const ony As String = "Onay: evet"
    Const tt As String = """"

    Set ws = Worksheets("Sayfa1")
    With ws
        sbt = .Range("D2").Value
        .Range("G6:G" & Rows.Count).Clear ' G6'dan en alta kadar eski verileri
        [COLOR="red"].Range("G5").Value = "Sonuçlar"[/COLOR]
        For i = 2 To .Range("B" & Rows.Count).End(xlUp).Row
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = grp & .Cells(i, "C") & sbt & tt
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = rmz & .Cells(i, "B") & tt
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = ony
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = grp & sbt & .Cells(i, "C") & tt
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = rmz & .Cells(i, "B") & tt
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = ony
        Next
        [COLOR="Red"].Range("G5").Clear[/COLOR]
    End With

End Sub
 
......................
 
Son düzenleme:
.....................
 
Son düzenleme:
...............
 
Son düzenleme:
......................
 
Son düzenleme:
mancubus' Alıntı:
veya kendisi yazsın... ve işi bitince silsin.
koda kırmızı satırları ilave ettim.

Kod: 
Sub Veri_Aktar()

    Dim ws As Worksheet
    Dim sbt As String
    
    Const grp As String = "Grup:"""
    Const rmz As String = "Rumuz:"""
    Const ony As String = "Onay: evet"
    Const tt As String = """"

    Set ws = Worksheets("Sayfa1")
    With ws
        sbt = .Range("D2").Value
        .Range("G6:G" & Rows.Count).Clear ' G6'dan en alta kadar eski verileri
        [COLOR="red"].Range("G5").Value = "Sonuçlar"[/COLOR]
        For i = 2 To .Range("B" & Rows.Count).End(xlUp).Row
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = grp & .Cells(i, "C") & sbt & tt
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = rmz & .Cells(i, "B") & tt
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = ony
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = grp & sbt & .Cells(i, "C") & tt
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = rmz & .Cells(i, "B") & tt
            .Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = ony
        Next
        [COLOR="Red"].Range("G5").Clear[/COLOR]
    End With

End Sub
Genişletmek için tıkla ...

Sayın mancubus

söylediğiniz gibi verilerimizi "" (tırnak) içine yazdıramadık.
Ben tırnak içine yazdırılacak diye
örnekte belirtmemiştim. Makromuzun amacı yeni makrolar üretmektir.

Sizinde bahsettiğniz gibi sabit ve değişkenlerimiz aşağıdaki şekildedir.
Kıyaslama yaparak olup olmayacağına karar verebilirsiniz.
Makromuzda çalışma mantığı gayet güzel herhangi bir hata yok.

Grup:"AhmetZeynep" = ElseIf x = "SSSSSSSSSOOOOOOOOOOOO" Then
Rumuz:"Karanfil" = Sayfa = "aaaaaaaaaaaaaa"
Onay: evet = GoTo 10

örneğimizideki Grup:"xxxxx" satırı
Grup:"xxxxx" Then şeklinde olacak.

bu durumda ne yapabiliriz acaba
ben kendimce birşeyler yapmaya çalıştım ama
başarılı olamadım.

Saygılarımla.
 
Sayın mancubus

Eğer bir çözümünüz yok ise şayet.
Makroyu çalıştırdıktan sonra
İkinci bir makro ile
"Grup" un geçtiği satırların sonuna "Then" verisini ilave edebiliriz.
(Koşulsuz olarak X satırında "Grup" adı geçiyorsa sonuna "Then" yaz gibi)
sorunumuzu bu şekilde halletmeyi umuyorum.
Bir değilde 2 makro kullanmış olacağız sadece.

Üstadlar illaki hallederler ama pek vazla kişi yok şuan için sanırım.

EDİT: Sayın mancubus

Yardımlarınızı için çok çok teşekkür ederim.
Hayatınızda sağlık mutulluk ve esenlikler temenni ediyorum.

Yukarıda bahsettiğim şekilde dosyaya 2. bir makro ilave ederek
sorunu hallettim.

Saygılarımla.

Kapalı dosya ile alakalı aşağıda bir konum var.
Yardımınız dokunursa sevinirim.
http://www.excel.web.tr/f48/kapaly-dosyalara-veri-kaydy-t123752.html#post674320
 
Son düzenleme:
Bu durumda olan bir formül kısaltılabilirmi?

..........................
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst