Sayfadaki buton ile seçilen satırda işlem yapılıp başka sayfaya kaydetme

T

tarikcengizkisa

Katılım
30 Haziran 2011
Mesajlar
14
Excel Vers. ve Dili
Excel 2002 2003 2007
Vba 6.0
Arkadaşlar merhabalar,

Yapmak istediğim biraz karmaşık bir işlem ama kodları yazdım tek ihtiyacım biraz düzenleme. Olay ise şu

Sheet1de belirsiz bir sayıda(3 5 10 belli olmuyor) satırı hücrelerdeki değerleri değişime uğratarak başka bir sayfaya atmak.

Ancak birkaç kısıt var. Bunlardan birincisi yazılan bir koddaki 2 adet harfe göre hangi sayfaya gideceği belirleniyor. 2. olarak mükerrer kayıt istenmiyor.

Kodları bir gözden geçirip hataları bulsanız başka birşeye gerek yok.

Şimdiden teşekkürler
 

Ekli dosyalar

İ

İhsan Tank

Misafir
sizin kod'u bilmem ama ben sıfırdan yazacağım makroyu yalnız bazı bilgiler sormalıyım
Import sayfasına göre güvenlik bölgesini nereden bulacağız
takip no giriş no'dan alınacak sanırım doğru ise hep standart bir ölçüde mi olacak. yani 8 rakam'dan sonra 2 harf sonra 6 rakam.

doğru ise bilgi verirseniz kod'unuzu yazmaya başlıyayım
 
T

tarikcengizkisa

Katılım
30 Haziran 2011
Mesajlar
14
Excel Vers. ve Dili
Excel 2002 2003 2007
Vba 6.0
Bilgiler doğrudur. Ayrıca import ve exporta güvenlik bölgesi guv_data isimli sayfadan vlookup formülü ile alınıyor.
 
İ

İhsan Tank

Misafir
o sayfa boş doldurup gönderirseniz yardımcı olmaya çalışırım
 
T

tarikcengizkisa

Katılım
30 Haziran 2011
Mesajlar
14
Excel Vers. ve Dili
Excel 2002 2003 2007
Vba 6.0
Hocam şu an internetten uzağım cep telefonundan yazıyorum akşam sonucu söyleyeceğim şimdiden ellerinize sağlık
 
T

tarikcengizkisa

Katılım
30 Haziran 2011
Mesajlar
14
Excel Vers. ve Dili
Excel 2002 2003 2007
Vba 6.0
İhsan hocam, ellerinize sağlık çok güzel çalışıyor bir tek şu tarih hücresi aynı şekilde gidiyor. yani 12.12.2011 00:00:00 >>12/12/2011 şeklinde gitmesi gerekirken hiçbir değişime uğramadan gidiyor. Nedenini anlayamadım ama?
 
İ

İhsan Tank

Misafir
tarikcengizkisa' Alıntı:
İhsan hocam, ellerinize sağlık çok güzel çalışıyor bir tek şu tarih hücresi aynı şekilde gidiyor. yani 12.12.2011 00:00:00 >>12/12/2011 şeklinde gitmesi gerekirken hiçbir değişime uğramadan gidiyor. Nedenini anlayamadım ama?
Genişletmek için tıkla ...
merhaba
üstteki eki güncelledim.
Sheet1 bu sayfadaki tarih'i girerken mutlaka 1/1 olarak giriş yapınız
 
T

tarikcengizkisa

Katılım
30 Haziran 2011
Mesajlar
14
Excel Vers. ve Dili
Excel 2002 2003 2007
Vba 6.0
İhsan Tank' Alıntı:
merhaba
üstteki eki güncelledim.
Sheet1 bu sayfadaki tarih'i girerken mutlaka 1/1 olarak giriş yapınız
Genişletmek için tıkla ...
Hocam öncelikle elinize sağlık çok güzel çalışıyor ama ben bir hata yapmışım durumu size anlatırken. bu import ve export sayfaları bizim veritabanımız. Sheet1 ise başka yerden kopyaladığımız bilgileri yapıştırdığımız bir sayfa bir geçit gibi. Biz misal 5 satır kopyaladıktan sonra veriler aktarılıyor ancak ben o satırlardaki giriş numaralarını değiştirdiğimde ve güncelle dediğimde(haliyle) kaydedilmiş verinin üstüne yazıyor. (Bu durum için çok özür dilerim beni affedin) Düzeltme imkanımız nedir hocam? Yani kaydı yapılan satırın sheet1 den silinmesi olabilir ama sütun silme ile ilgili bir faaliyetim olmamıştı hiç :)
 
İ

İhsan Tank

Misafir
tarikcengizkisa' Alıntı:
Hocam öncelikle elinize sağlık çok güzel çalışıyor ama ben bir hata yapmışım durumu size anlatırken. bu import ve export sayfaları bizim veritabanımız. Sheet1 ise başka yerden kopyaladığımız bilgileri yapıştırdığımız bir sayfa bir geçit gibi. Biz misal 5 satır kopyaladıktan sonra veriler aktarılıyor ancak ben o satırlardaki giriş numaralarını değiştirdiğimde ve güncelle dediğimde(haliyle) kaydedilmiş verinin üstüne yazıyor. (Bu durum için çok özür dilerim beni affedin) Düzeltme imkanımız nedir hocam? Yani kaydı yapılan satırın sheet1 den silinmesi olabilir ama sütun silme ile ilgili bir faaliyetim olmamıştı hiç :)
Genişletmek için tıkla ...
ne demek istediğinizi inanın anlamadım.
lütfen biraz daha açık ve detaylı anlatır mısınız
 
T

tarikcengizkisa

Katılım
30 Haziran 2011
Mesajlar
14
Excel Vers. ve Dili
Excel 2002 2003 2007
Vba 6.0
İhsan Tank' Alıntı:
ne demek istediğinizi inanın anlamadım.
lütfen biraz daha açık ve detaylı anlatır mısınız
Genişletmek için tıkla ...
Tabiki hocam öncelikle tekrardan kusura bakmayın.

Şimdi programı bir gözünüzün önüne getirin. 5 satırı biz aldık başka bir dosyanın başka bir sayfasından "Sheet1" e yapıştırdık. Sonra güncelle butonuna bastık(makroyu atadığımız buton) ve giriş numarasındaki ex veya im e göre import veya export a yönlendi. Buraya kadar bir sorun yok. Burda benim bir hatam var size birşeyi eksik söylemişim. Bizim "sheet1" sayfası sadece bilgiyi uygun bir şekilde(tarihteki . / değişimi veya aidattaki . , değişimi gibi) import ve export sayfalarına atması için aracı. Biz bilgiyi başka aslında başka bir dosyanın bir sayfasından "sheet1" e uygun düzenlemeler yapılabilsin diye kopyalıyoruz.

Sorun ne derseniz. Sizin yazdığınız programda "sheet1"in birinci satırı giriş numarasında ex var ise export sayfasının birinci satırına gidiyor. ben de diyorum ki biz bir defa onu öyle güncelledik kaydettik exporta işlem sonunda sheet1den hangi sütunları atmışsak hepsi silinsin sheet1den

Kod: 
Next
    MsgBox "Verileri Aktarıldı", vbInformation, "Bitiş"
    Sheets("Sheet1").Range("A2:H65536").ClearContents
    End Sub
Böyle hallettim bu kısmını. Ama "export" veya "import" sayfasında her "güncellemede" birinci satırdan başlamaması işini bir türlü halledemedim. Yani sürekli kaydetmesi gerekiyor. her güncellemeden sonra bir alttaki boş satıra.

Umarım anlatabilmişimdir.
 
İ

İhsan Tank

Misafir
benim anladığım şu ımport ve export sayfalarındaki veriler kalsın.
sheet1'deki veriler devamlı temizlendikce ımport ve export sayfalarına eklensin eski ve yeni bilgiler.
doğru mu anlamışım
 
T

tarikcengizkisa

Katılım
30 Haziran 2011
Mesajlar
14
Excel Vers. ve Dili
Excel 2002 2003 2007
Vba 6.0
Hocam tamamen öyle anladığınız doğrudur. Envanter gibi sürekli kayıt :)
 
İ

İhsan Tank

Misafir
tarikcengizkisa' Alıntı:
Hocam tamamen öyle anladığınız doğrudur. Envanter gibi sürekli kayıt :)
Genişletmek için tıkla ...
merhaba
modul'deki kodu bununla değiştirin ve butona atayın
Kod: 
Option Explicit
Sub devamlı()
Dim ts, kaplan, ımport, export, sheet1, trabzonspor
trabzonspor = MsgBox("Verileri Aktarayım Mı_?", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
ımport = Sheets("Import").Range("A65536").End(xlUp).Row
export = Sheets("Export").Range("A65536").End(xlUp).Row
ts = ımport + 1
kaplan = export + 1
For sheet1 = 2 To Sheets("Sheet1").Cells(65536, "E").End(xlUp).Row
Sheets("Sheet1").Cells(sheet1, "AD") = Mid(Sheets("Sheet1").Cells(sheet1, "E"), 9, 2)
If Sheets("Sheet1").Cells(sheet1, "AD") = "IM" Then
Sheets("Import").Range("A" & ts).Value = Sheets("Sheet1").Cells(sheet1, "C")
Sheets("Import").Range("B" & ts).Value = Sheets("Sheet1").Cells(sheet1, "D")
Sheets("Import").Range("C" & ts).Value = Sheets("Sheet1").Cells(sheet1, "E")
If WorksheetFunction.CountIf(Sheets("gum_data!").Range("A2:A65536"), Mid(Sheets("Sheet1"). _
Cells(sheet1, "E"), 3, 6)) > 0 Then
Sheets("Import").Range("D" & ts).Value = WorksheetFunction.VLookup(Mid(Sheets("Sheet1"). _
Cells(sheet1, "E"), 3, 6), Sheets("gum_data!").Range("A2:C65536"), 3, 0)
Else
Sheets("Import").Range("D" & ts).Value = "Böyle Bir Güvenlik Yok"
End If
Sheets("Import").Range("E" & ts).Value = Right(Sheets("Sheet1").Cells(sheet1, "E"), 8)
Sheets("Import").Range("F" & ts).Value = Sheets("Sheet1").Cells(sheet1, "F")
Sheets("Import").Range("H" & ts).Value = Sheets("Sheet1").Cells(sheet1, "G")
ElseIf Sheets("Sheet1").Cells(sheet1, "AD") = "EX" Then
Sheets("Export").Range("A" & kaplan).Value = Sheets("Sheet1").Cells(sheet1, "C")
Sheets("Export").Range("B" & kaplan).Value = Sheets("Sheet1").Cells(sheet1, "D")
Sheets("Export").Range("C" & kaplan).Value = Sheets("Sheet1").Cells(sheet1, "E")
If WorksheetFunction.CountIf(Sheets("gum_data!").Range("A2:A65536"), Mid(Sheets("Sheet1"). _
Cells(sheet1, "E"), 3, 6)) > 0 Then
Sheets("Export").Range("D" & kaplan).Value = WorksheetFunction.VLookup(Mid(Sheets("Sheet1"). _
Cells(sheet1, "E"), 3, 6), Sheets("gum_data!").Range("A2:C65536"), 3, 0)
Else
Sheets("Export").Range("D" & kaplan).Value = "Böyle Bir Güvenlik Yok"
End If
Sheets("Export").Range("E" & kaplan).Value = Right(Sheets("Sheet1").Cells(sheet1, "E"), 8)
Sheets("Export").Range("F" & kaplan).Value = Sheets("Sheet1").Cells(sheet1, "F")
Sheets("Export").Range("H" & kaplan).Value = Sheets("Sheet1").Cells(sheet1, "G")
End If
Next
Sheets("Sheet1").Range("A2:AD65536").ClearContents
MsgBox "Verileri Aktardım", vbInformation, "Bitiş"
End Sub
 
T

tarikcengizkisa

Katılım
30 Haziran 2011
Mesajlar
14
Excel Vers. ve Dili
Excel 2002 2003 2007
Vba 6.0
Hocam ellerinize sağlık ben bi de buna mükerrer kontrolü de ekledim bal oldu bal :D Allah razı olsun
 
T

tarikcengizkisa

Katılım
30 Haziran 2011
Mesajlar
14
Excel Vers. ve Dili
Excel 2002 2003 2007
Vba 6.0
İhsan Tank' Alıntı:
kolay gelsin
Allah Hepimizden Razı Olsun
:yazici:
Genişletmek için tıkla ...
İhsan hocam bu gün çok şey istedim sizden ama son bir şey kaldı son bir yardım edin bitirelim şu işi.

Kod: 
For muke = 2 To Sheets("Sheet1").Cells(65536, "E").End(xlUp).Row
    If Sheets("Export").Cells(export, "C") = Sheets("Sheet1").Cells(muke, "E") Then
    MsgBox "Mükerrer kayıt var. Lütfen karşılaştırınız."
    Exit Sub
    
    ElseIf Sheets("Import").Cells(ımport, "C") = Sheets("Sheet1").Cells(muke, "E") Then
    MsgBox "Mükerrer kayıt var. Lütfen karşılaştırınız."
    Exit Sub
    
    Else
...(kayıt kodları)
Mükerrer kayıdı önlemek için bu kodu ekledim başına bi çalışıyor bi çalışmıyor tam verim vermedi. Amacım Sheet1de Edeki giriş numarası ile import ve export sayfasında C sütununda olan giriş numaralarını karşılaştırmak. Arada mükerrer varsa uyarı vermek.(kodlardan anlamışsınızdır zaten)

Neresini düzeltmek gerekir hocam?
 
İ

İhsan Tank

Misafir
tarikcengizkisa' Alıntı:
İhsan hocam bu gün çok şey istedim sizden ama son bir şey kaldı son bir yardım edin bitirelim şu işi.

Kod: 
For muke = 2 To Sheets("Sheet1").Cells(65536, "E").End(xlUp).Row
    If Sheets("Export").Cells(export, "C") = Sheets("Sheet1").Cells(muke, "E") Then
    MsgBox "Mükerrer kayıt var. Lütfen karşılaştırınız."
    Exit Sub
    
    ElseIf Sheets("Import").Cells(ımport, "C") = Sheets("Sheet1").Cells(muke, "E") Then
    MsgBox "Mükerrer kayıt var. Lütfen karşılaştırınız."
    Exit Sub
    
    Else
...(kayıt kodları)
Mükerrer kayıdı önlemek için bu kodu ekledim başına bi çalışıyor bi çalışmıyor tam verim vermedi. Amacım Sheet1de Edeki giriş numarası ile import ve export sayfasında C sütununda olan giriş numaralarını karşılaştırmak. Arada mükerrer varsa uyarı vermek.(kodlardan anlamışsınızdır zaten)

Neresini düzeltmek gerekir hocam?
Genişletmek için tıkla ...
merhaba
üstte verdiğim kod'u bununla değişin
Kod: 
Option Explicit
Sub devamlı()
Dim ts, kaplan, ımport, export, sheet1, trabzonspor, bordo
trabzonspor = MsgBox("Verileri Aktarayım Mı_?", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
For bordo = 2 To Sheets("Sheet1").Cells(65536, "E").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("Import").Range("C2:C65536"), Sheets("Sheet1").Cells(bordo, "E")) = 1 Then
MsgBox Sheets("Sheet1").Cells(bordo, "C") & " Veri Var"
Sheets("Sheet1").Cells(bordo, "C") = "": Sheets("Sheet1").Cells(bordo, "D") = ""
Sheets("Sheet1").Cells(bordo, "E") = "": Sheets("Sheet1").Cells(bordo, "F") = ""
Sheets("Sheet1").Cells(bordo, "G") = ""
ElseIf WorksheetFunction.CountIf(Sheets("Export").Range("C2:C65536"), Sheets("Sheet1").Cells(bordo, "E")) = 1 Then
MsgBox Sheets("Sheet1").Cells(bordo, "C") & " Veri Var"
Sheets("Sheet1").Cells(bordo, "C") = "": Sheets("Sheet1").Cells(bordo, "D") = ""
Sheets("Sheet1").Cells(bordo, "E") = "": Sheets("Sheet1").Cells(bordo, "F") = ""
Sheets("Sheet1").Cells(bordo, "G") = ""
End If
Next
ımport = Sheets("Import").Range("A65536").End(xlUp).Row
export = Sheets("Export").Range("A65536").End(xlUp).Row
ts = ımport + 1
kaplan = export + 1
For sheet1 = 2 To Sheets("Sheet1").Cells(65536, "E").End(xlUp).Row
Sheets("Sheet1").Cells(sheet1, "AD") = Mid(Sheets("Sheet1").Cells(sheet1, "E"), 9, 2)
If Sheets("Sheet1").Cells(sheet1, "AD") = "IM" Then
Sheets("Import").Range("A" & ts).Value = Sheets("Sheet1").Cells(sheet1, "C")
Sheets("Import").Range("B" & ts).Value = Sheets("Sheet1").Cells(sheet1, "D")
Sheets("Import").Range("C" & ts).Value = Sheets("Sheet1").Cells(sheet1, "E")
If WorksheetFunction.CountIf(Sheets("gum_data!").Range("A2:A65536"), Mid(Sheets("Sheet1"). _
Cells(sheet1, "E"), 3, 6)) > 0 Then
Sheets("Import").Range("D" & ts).Value = WorksheetFunction.VLookup(Mid(Sheets("Sheet1"). _
Cells(sheet1, "E"), 3, 6), Sheets("gum_data!").Range("A2:C65536"), 3, 0)
Else
Sheets("Import").Range("D" & ts).Value = "Böyle Bir Güvenlik Yok"
End If
Sheets("Import").Range("E" & ts).Value = Right(Sheets("Sheet1").Cells(sheet1, "E"), 8)
Sheets("Import").Range("F" & ts).Value = Sheets("Sheet1").Cells(sheet1, "F")
Sheets("Import").Range("H" & ts).Value = Sheets("Sheet1").Cells(sheet1, "G")
ElseIf Sheets("Sheet1").Cells(sheet1, "AD") = "EX" Then
Sheets("Export").Range("A" & kaplan).Value = Sheets("Sheet1").Cells(sheet1, "C")
Sheets("Export").Range("B" & kaplan).Value = Sheets("Sheet1").Cells(sheet1, "D")
Sheets("Export").Range("C" & kaplan).Value = Sheets("Sheet1").Cells(sheet1, "E")
If WorksheetFunction.CountIf(Sheets("gum_data!").Range("A2:A65536"), Mid(Sheets("Sheet1"). _
Cells(sheet1, "E"), 3, 6)) > 0 Then
Sheets("Export").Range("D" & kaplan).Value = WorksheetFunction.VLookup(Mid(Sheets("Sheet1"). _
Cells(sheet1, "E"), 3, 6), Sheets("gum_data!").Range("A2:C65536"), 3, 0)
Else
Sheets("Export").Range("D" & kaplan).Value = "Böyle Bir Güvenlik Yok"
End If
Sheets("Export").Range("E" & kaplan).Value = Right(Sheets("Sheet1").Cells(sheet1, "E"), 8)
Sheets("Export").Range("F" & kaplan).Value = Sheets("Sheet1").Cells(sheet1, "F")
Sheets("Export").Range("H" & kaplan).Value = Sheets("Sheet1").Cells(sheet1, "G")
End If
Next
Sheets("Sheet1").Range("A2:AD65536").ClearContents
MsgBox "Verileri Aktardım", vbInformation, "Bitiş"
End Sub
deneyin ben bir kaç deneme yaptım
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst