Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 03-03-2017, 08:27   #1
savasizgeneral
 
Giriş: 14/02/2008
Mesaj: 19
Excel Vers. ve Dili:
office 2003 türkçe
Varsayılan Makro ile şartlı aktarma

Merhaba ben bir sayfadan diğer sayfaya veri dağıtmak istiyorum, fakat dağıtacağım verilerin belli şartlara göre gelmesini istiyorum.
Dağıtılacak sayı b sütünunda dağıtım şekli data sayfasından alınacak
Data sayfasındaki a sütunundaki sayılar baz alınıp bulunan sayıya göre b ile j sutunu arasındaki sayılar sayfa 1 deki d ile ah sutununa dağıtılacak
Sayfa 1 deki d ile ah sütunu arasında dağılacak olan sayılar sadece sütunlardaki 'N' yazan yerlere yazılacak
Dağıtımda öncelik olarak 'N' ler arasında en az 2 boşluk olacak şekilde olacak yani 2 'N' ye yanyana yazmayacak , fakat yazdırılacak alan yetmediği durumlarda aradaki boşluk kademeli olarak 1 boşluk ve boşluk yok olarak düşebilir.


Teşekkürler.
Eklenmiş Dosyalar
Dosya Türü: xls RASTGELE DAĞIT.xls (29.5 KB, 15 Görüntülenme)

Bu mesaj en son " 07-03-2017 " tarihinde saat 09:41 itibariyle savasizgeneral tarafından düzenlenmiştir.... Neden: içerik ekleme
savasizgeneral Çevrimdışı   Alıntı Yaparak Cevapla
Eski 07-03-2017, 10:37   #2
savasizgeneral
 
Giriş: 14/02/2008
Mesaj: 19
Excel Vers. ve Dili:
office 2003 türkçe
Varsayılan

Arkadaşlar sorunumu parça parça çözmeye çalışacam aşağıdaki makro ile veriyi aktarabiliyorum, benim istediğim aktarım yapılan hücreler benim dosyamda dolu olacak ben bir kriter belirleyip belirlediğim kritere göre aktarım yapmasını istiyorum, yani c sutunda bir veri arayıp o verinin üzerine yazacak. aynı işlemleri diğer sütünlarda da yapacak.


Sub arabul59()
Dim sh As Worksheet, sonsat1 As Long, sonsat2 As Long
Dim i As Long, k As Range
Set sh = Sheets("Sayfa1")
sonsat1 = sh.Cells(Rows.Count, "A").End(xlUp).Row
sonsat2 = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To sonsat2
Set k = sh.Range("A2:A" & sonsat1).Find(Cells(i, "A").Value, , xlValues, xlWhole)
If Not k Is Nothing Then
Cells(i, "c").Value = k.Offset(0, 10).Value
Cells(i, "d").Value = k.Offset(0, 9).Value
Cells(i, "e").Value = k.Offset(0, 8).Value
Cells(i, "f").Value = k.Offset(0, 7).Value
Cells(i, "g").Value = k.Offset(0, 6).Value
Cells(i, "h").Value = k.Offset(0, 5).Value
Cells(i, "ı").Value = k.Offset(0, 4).Value
Cells(i, "j").Value = k.Offset(0, 3).Value
Cells(i, "k").Value = k.Offset(0, 2).Value
Cells(i, "l").Value = k.Offset(0, 1).Value
End If
Next i
MsgBox "İşlem tamamlanmıştır."
End Sub
Eklenmiş Dosyalar
Dosya Türü: xls RASTGELE DAĞIT.xls (44.0 KB, 7 Görüntülenme)
savasizgeneral Çevrimdışı   Alıntı Yaparak Cevapla
Eski 07-03-2017, 15:18   #3
savasizgeneral
 
Giriş: 14/02/2008
Mesaj: 19
Excel Vers. ve Dili:
office 2003 türkçe
Varsayılan

Bu makro ile yukarıdaki makro birleştirilebilir mi?

With Worksheets(1).Range("a1:a500")
Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
savasizgeneral Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-03-2017, 10:57   #4
Ömer BARAN
Uzman
 
Giriş: 08/03/2011
Şehir: ANKARA / İSTANBUL
Mesaj: 9,481
Excel Vers. ve Dili:
Office 2013 TÜRKÇE
Varsayılan

Merhaba.

Belge ekte.
.
Eklenmiş Dosyalar
Dosya Türü: xls RASTGELE_DAĞIT_BRN.xls (53.5 KB, 21 Görüntülenme)
__________________
.
☾✭ İnadına TÜRKÇE ✭☽

-- Sorunuzu, gerçek belgenizle aynı yapıda ve olması gereken sonuçların elle yazıldığı örnek belge ile destekleyiniz.
-- ALTIN ÜYELİK öneriyorum. / FORUM KURALLARInı mutlaka okuyunuz.
-- ALTIN ÜYE olmayanlar, örnek belgeyi dosya.tc, dosya.co gibi bir siteye yükleyip, belgeye erişim adresini verebilir.
-- Özel mesaj ile soru sormayınız. / Geri bildirimde bulunulmayan cevaplarımı siliyorum.
Ömer BARAN Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-03-2017, 11:05   #5
savasizgeneral
 
Giriş: 14/02/2008
Mesaj: 19
Excel Vers. ve Dili:
office 2003 türkçe
Varsayılan

Alıntı:
Ömer BARAN tarafından gönderildi Mesajı Görüntüle
Merhaba.

Belge ekte.
.
Çok teşekkür ederim Ömer bey.
savasizgeneral Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-03-2017, 12:06   #6
savasizgeneral
 
Giriş: 14/02/2008
Mesaj: 19
Excel Vers. ve Dili:
office 2003 türkçe
Varsayılan

Ömer bey bi sorum daha olacak şimdi bu yaptığınız makroyu ben kendi çalışma kitabıma uyarlamaya çalıştım fakat beceremedim, dağıtılacak sayı kısmını nasıl değiştirebilirim b sütunu yerine başka sütunu nasıl gösterebilirim? Makro değişiklik yapılabilecek şekilde düzenlenebilir mi?
Teşekkürler.

Sub DAGITIM_BRN()
Set s1 = Sheets("Sayfa1"): Set sd = Sheets("data")
Set wf = Application.WorksheetFunction
For sat = 3 To s1.Cells(Rows.Count, 2).End(3).Row
dsat = s1.Cells(sat, 2) + 1
dadet = sd.Cells(s1.Cells(sat, 2) + 1, 256).End(1).Column - 1
nadet = wf.CountIf(s1.Range("D" & sat & ":AH" & sat), "N")
sekme = Int(nadet / dadet)
ilk = wf.Match("N", s1.Range("D" & sat & ":AH" & sat), 0) + 3: sayı = 0: dsut = 2
s1.Cells(sat, ilk) = sd.Cells(dsat, dsut)
For n = ilk + 1 To 34
If s1.Cells(sat, n) = "N" Then
sayı = sayı + 1
If sayı >= sekme Then
If dsut >= dadet + 1 Then GoTo 20
dsut = dsut + 1: s1.Cells(sat, n) = sd.Cells(dsat, dsut): sayı = 0
End If: End If: Next
20: Next
End Sub

Sub BAŞA_DÖN()
For sat = 3 To Cells(Rows.Count, 2).End(3).Row
For sut = 4 To 34
Cells(sat, sut) = Cells(sat + 15, sut)
Next
Next
End Sub
savasizgeneral Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-03-2017, 12:17   #7
Ömer BARAN
Uzman
 
Giriş: 08/03/2011
Şehir: ANKARA / İSTANBUL
Mesaj: 9,481
Excel Vers. ve Dili:
Office 2013 TÜRKÇE
Varsayılan

Alıntı:
savasizgeneral tarafından gönderildi Mesajı Görüntüle
Ömer bey bi sorum daha olacak şimdi bu yaptığınız makroyu ben kendi çalışma kitabıma uyarlamaya çalıştım fakat beceremedim, dağıtılacak sayı kısmını nasıl değiştirebilirim b sütunu yerine başka sütunu nasıl gösterebilirim? Makro değişiklik yapılabilecek şekilde düzenlenebilir mi?
Teşekkürler.
Merhaba.

Kırmızı işaretledim.
.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
For sat = 3 To s1.Cells(Rows.Count, "B").End(3).Row
dsat = s1.Cells(sat, "B") + 1
dadet = sd.Cells(dsat, 256).End(1).Column - 1
__________________
.
☾✭ İnadına TÜRKÇE ✭☽

-- Sorunuzu, gerçek belgenizle aynı yapıda ve olması gereken sonuçların elle yazıldığı örnek belge ile destekleyiniz.
-- ALTIN ÜYELİK öneriyorum. / FORUM KURALLARInı mutlaka okuyunuz.
-- ALTIN ÜYE olmayanlar, örnek belgeyi dosya.tc, dosya.co gibi bir siteye yükleyip, belgeye erişim adresini verebilir.
-- Özel mesaj ile soru sormayınız. / Geri bildirimde bulunulmayan cevaplarımı siliyorum.
Ömer BARAN Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-03-2017, 13:04   #8
savasizgeneral
 
Giriş: 14/02/2008
Mesaj: 19
Excel Vers. ve Dili:
office 2003 türkçe
Varsayılan

Kırmız ile belirtiğim yerde hata veriyor.


Sub DAGITIM_BRN()
Set s1 = Sheets("MESAİ VE İZİNLER"): Set sd = Sheets("SAAT")
Set wf = Application.WorksheetFunction
For sat = 3 To s1.Cells(Rows.Count, "C").End(3).Row
dsat = s1.Cells(sat, "C") + 1
dadet = sd.Cells(s1.Cells(dsat, 2) + 1, 256).End(1).Column - 1
nadet = wf.CountIf(s1.Range("D" & sat & ":AH" & sat), "x")
sekme = Int(nadet / dadet)
ilk = wf.Match("x", s1.Range("D" & sat & ":AH" & sat), 0) + 3: sayı = 0: dsut = 2
s1.Cells(sat, ilk) = sd.Cells(dsat, dsut)
For n = ilk + 1 To 34
If s1.Cells(sat, n) = "x" Then
sayı = sayı + 1
If sayı >= sekme Then
If dsut >= dadet + 1 Then GoTo 20
dsut = dsut + 1: s1.Cells(sat, n) = sd.Cells(dsat, dsut): sayı = 0
End If: End If: Next
20: Next
End Sub
savasizgeneral Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-03-2017, 13:31   #9
Ömer BARAN
Uzman
 
Giriş: 08/03/2011
Şehir: ANKARA / İSTANBUL
Mesaj: 9,481
Excel Vers. ve Dili:
Office 2013 TÜRKÇE
Varsayılan

Gerçek belgeyle aynı yapıda örnek belge üzerinden destek istenilmeyince böyle durumlar oluyor.
Örnek belgenizi, gerçek belgenizle aynı yapıda olacak şekilde ekleyin bakayım.
(sayfa adı/ veri başlangıç-bitiş satırı aynı olacak şekilde, data sayfası için de aynı şey geçerli)
.
__________________
.
☾✭ İnadına TÜRKÇE ✭☽

-- Sorunuzu, gerçek belgenizle aynı yapıda ve olması gereken sonuçların elle yazıldığı örnek belge ile destekleyiniz.
-- ALTIN ÜYELİK öneriyorum. / FORUM KURALLARInı mutlaka okuyunuz.
-- ALTIN ÜYE olmayanlar, örnek belgeyi dosya.tc, dosya.co gibi bir siteye yükleyip, belgeye erişim adresini verebilir.
-- Özel mesaj ile soru sormayınız. / Geri bildirimde bulunulmayan cevaplarımı siliyorum.
Ömer BARAN Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-03-2017, 13:48   #10
savasizgeneral
 
Giriş: 14/02/2008
Mesaj: 19
Excel Vers. ve Dili:
office 2003 türkçe
Varsayılan

Şuan kullandığım dosyamı ekledim bunu üzerinde düzenler misiniz?

Teşekkürler.
Eklenmiş Dosyalar
Dosya Türü: xlsm Puantaj mesai saatleri.xlsm (85.6 KB, 10 Görüntülenme)
savasizgeneral Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 11:33


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Dil Konuşma Terapisti- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Çorlu- Çorlu Araç Takip- Çorlu Su Arıtma- Gebze Emlak- Rampa- Rotary- Çorlu İnternet Sitesi- Çorlu Sürücü Kursu- Çorlu Sürücü Kursu- Şişli Avukat- Edirne Serbest Muhasebeci- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta- Kağıt Bardak- Kaplan Tekstil- Çorlu Perde- Çorlu Havuz- Makina- Danışmazlar-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden