Bazı bilgileri başka bir sheette istenilen yere getirmek.

Katılım
17 Nisan 2007
Mesajlar
319
Excel Vers. ve Dili
Office 2013 Türkçe
Sevgili üstadlar merhaba ,

Benim bir konuda yardıma ihtiyacım var.Ekli dosyada pivot ve data sheetleri var.Burada pivot sheetinde E ve F sütunlarında sürücü ve plaka bilgileri var.A sütununda da 1,2,3....100 şeklinde sayılar var.Şimdi benim yapmak istediğim sürücü ve plaka kısmını DATA sheetinde peron yazan sütundaki ilk sayıya karşılık H sütununa yazdırmak...Dosyada Data kısmında olması gerektiği şekilde 2-3 örnek yazdım.

Bu konuda yardımcı olabilirseniz çok mutlu olurum.Şimdiden tşk. ederim...

İyi çalışmalar...
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Merhaba.
PIVOT sayfasındaki numara bölgelerine numaraları giriniz.Ben ilk 3 - 4 tane girdim.
Dosyanız ekte.:cool:
Dosya güncellendi.:cool:
Kod:
Sub aktar()
Dim i As Long
Sheets("PIVOT").Select
Sheets("DATA").Range("H2:I65536").ClearContents
For i = 2 To Cells(65536, "E").End(xlUp).Row
If Cells(i, "E").Value <> "" Then
    Set c = Sheets("DATA").Range("A:A").Find(Cells(i, "A").Value, , xlValues, xlWhole)
    If Not c Is Nothing Then
        For j = c.Row To Sheets("DATA").Cells(65536, "A").End(xlUp).Row
            If Sheets("DATA").Cells(j, "B").Value = Cells(i, "B").Value _
            And Sheets("DATA").Cells(j, "C").Value = Cells(i, "C").Value Then
                Sheets("DATA").Cells(j, "H").Value = Cells(i, "E").Value
                Sheets("DATA").Cells(j, "I").Value = Cells(i, "F").Value
                GoTo atla
            End If
        Next j
atla:
    End If
End If
Next i
MsgBox "A K T A R M A     T A M A M L A N D I..!!", vbOKOnly, Application.UserName
End Sub
 
Son düzenleme:
Katılım
17 Nisan 2007
Mesajlar
319
Excel Vers. ve Dili
Office 2013 Türkçe
Sevgili Sezar

&#214;ncelikle &#231;ok ilgin ve alakan icin cok t&#351;k. ederim.Sadece bir problem var.Pivot sheetinde baz&#305; say&#305;larda 2 s&#252;r&#252;c&#252; ve plaka var. onlar&#305; tek olarak yaz&#305;yor.Mesela benim g&#246;nderdi&#287;im dosyada 16 'da 2 s&#252;r&#252;c&#252; ve plaka var.Makroyu &#231;al&#305;&#351;t&#305;r&#305;nca data sheetinde ilgili yere tek s&#252;r&#252;c&#252; ve plaka yaz&#305;yor.
Bunu nas&#305;l d&#252;zeltebiliriz ?

&#350;imdiden t&#351;k. dostum Saol....
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Dosyayı güncelledim.
Önceki mesajımdan indirip deneyebilirsiniz.:cool:
 
Katılım
17 Nisan 2007
Mesajlar
319
Excel Vers. ve Dili
Office 2013 Türkçe
&#199;ok ama &#199;ok te&#351;ekk&#252;r ederim Sezar...
Ellerin dert klavyen zeval g&#246;rmesin...Saol Varol...
 
Katılım
17 Nisan 2007
Mesajlar
319
Excel Vers. ve Dili
Office 2013 Türkçe
Sezar
aff&#305;n&#305;za s&#305;&#287;&#305;narak birsey daha sormak istiyorum.Ben bu makroyu eklenti yapmak istiyorum.Bunu nas&#305;l yap&#305;caz...T&#351;k.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Farkılı Kaydet'ten
Microsoft ofis eklentisi(*.xla) olarak kaydedin.
Otomatik olarak addins klasörüne kendisi kaydedecektir.
Araçlar ==> eklentiler ==> Gözat'tan tamam deyin vecheckbox'ı işaretleyin eklenti olarak kaydedilecektir.:cool:
 
Katılım
17 Nisan 2007
Mesajlar
319
Excel Vers. ve Dili
Office 2013 Türkçe
Dediginiz gibi yapt&#305;m fakat yeni bir excel sayfas&#305; a&#231;t&#305;&#287;&#305;mda makro k&#305;sm&#305; bo&#351; geliyor.
 
Katılım
17 Nisan 2007
Mesajlar
319
Excel Vers. ve Dili
Office 2013 Türkçe
evet denedim fakat oras&#305; bo&#351; geliyor.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
evet denedim fakat orası boş geliyor.
Araçlar ==> eklentiler 'e bakın dosya orda listelenmişmi .Listelenmişse yanındaki kutucupu çek edin.Eğer listelenmemişse dosyayı eklenti olarak kaydetmemişsiniz.Önceki mesajımı tekrardan iyice okuyup ona göre tekrardan deneyin.:cool:
 
Katılım
17 Nisan 2007
Mesajlar
319
Excel Vers. ve Dili
Office 2013 Türkçe
Evet listede var ve yan&#305;ndada check i&#351;areti var.Ayr&#305;ca VB editorden bak&#305;ncada makro g&#246;r&#252;n&#252;yor.Fakat run makro yapmak istedi&#287;imde makro k&#305;sm&#305; bo&#351; geliyor.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Evet ayni sorun bendede var.Bende çalıştıramadım.
VBE'de gözüküyor ama run makroda gözükmüyor.
Üstadlar buna ne derler ?Yardım..!!!:yardim: :yardim: :yardim:
 
Katılım
13 Temmuz 2007
Mesajlar
4
Excel Vers. ve Dili
Versiyon : Excel 2003
Dil : Türkçe
Merhaba arkadaşlar,

Benim iade isminde bir çalışma dosyam var. İçerisinde
Genel sayfası : Tüm oranlarda iade dosyası var
% 1 : Genel sayfası içerisinden yalnızca %1'lik satışlar olmalı
% 8 : Genel sayfası içerisinden yalnızca %1'lik satışlar olmalı
% 18 : Genel sayfası içerisinden yalnızca %1'lik satışlar olmalı

Ama bir türlü yapamadım. yalnız bir ricam var; 610 hesaptakiler 610 hesaplara, 191 hesaptakiler 191 hesaplar yazılacak ( Tarih, Açıklama ve Tarih ).
Bana yardımcı olursanız sevinirim.


İyi çalışmalar,
Zeynel SENAN
 
Katılım
14 Şubat 2006
Mesajlar
3,426
Excel Vers. ve Dili
(Excel 2016 - İngilizce)
Altın Üyelik Bitiş Tarihi
30-11-2022
Eklenti dosyası farklı bir çalışma kitabı olduğu için bu dosyanın makroları bu kitaba aitdir.
Dikkat ederseniz VBE ekranında eklenti dosyasına tıklarsanız makronun burada olduğunu göreceksiniz.
Dolayısıyla makroyu buradan çalıştırmanız yeterli olacaktır.

.xla dosyasından .xls dosyasındaki bir sayfayı seçip işlem yaptırmak içinse bu sayfaların set edilmesi yani tanımlanması gerekmekdir.

Kodlarınızı aşağıdaki şekilde değiştirirseniz makro doğru çalışacaktır.

Kod:
Sub aktar()
Dim i As Long
[color=blue]Set wb1 = Workbooks("ornek2.xls").Worksheets("PIVOT")
Set wb2 = Workbooks("ornek2.xls").Worksheets("DATA")[/color]
wb1.Select
wb2.Range("H2:I65536").ClearContents
For i = 2 To wb1.Cells(65536, "E").End(xlUp).Row
If wb1.Cells(i, "E").Value <> "" Then
    Set c = wb2.Range("A:A").Find(Cells(i, "A").Value, , xlValues, xlWhole)
    If Not c Is Nothing Then
        For j = c.Row To wb2.Cells(65536, "A").End(xlUp).Row
            If wb2.Cells(j, "B").Value = wb1.Cells(i, "B").Value _
            And wb2.Cells(j, "C").Value = wb1.Cells(i, "C").Value Then
                wb2.Cells(j, "H").Value = wb1.Cells(i, "E").Value
                wb2.Cells(j, "I").Value = wb1.Cells(i, "F").Value
                GoTo atla
            End If
        Next j
atla:
    End If
End If
Next i
Set wb1 = Nothing
Set wb2 = Nothing
Set c = Nothing
MsgBox "A K T A R M A     T A M A M L A N D I..!!", vbOKOnly, Application.UserName
End Sub
ornek2.xls dosyasından .xla dosyasındaki bu makroyu direk çalıştırmak içinse,
Kod:
Sub xlaMakroÇalıştır()
Application.Run ("ornek2.xla!aktar")
End Sub
kodlarını kullanabilirsiniz.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Merhabalar.
Sayın hocam değerli bilgileriniz için teşekkür ederim.
İyi geceler.:)
 
Üst