Çok koşullu Aktarma

[reckly]

Arkadaşlar Merhaba,

Buradaki bir çok aktarma makrosunu inceledim, kendi istediğim şekle tam olarak uygulayamadım. Elimdeki dosya burada örneklediğimden çok çok uzun. Amacım 2.xls dosyasındaki her evrak nosu için bir sheet açmak ve D sütunundaki her kod için F sütunundaki adet kadar 1.xls dosyasından sıra ile veri taşımak. Ama burdaki en önemli durum taşınan satırların çıkış tarihlerinin 2.xls dosyasının 1.sayfasındaki dosya tarihinden 3gün büyük olmasıdır.
Örnek olması açısından 2.xls dosyasında 22777 sheetine bakabilirsiniz.
Yardımlarınız için şimdiden teşekkürler.

 

[reckly]

Arkadaşlar yardım edebilecek varmı acaba?
Teşekkürler.

 

[reckly]

Acaba sitede bulamadığım, benim aradığım gibi bir aktarma makrosu mevcut mu? Bu konuda fikri olan var mı?
Teşekkürler.

 

[reckly]

Arkadaş aktarma ile ilgili yardım edebilecek var mı?

 

[Ferhat Pazarçevirdi]

Merhabalar

Yani, bir insanın kafası anca bu kadar karıştırılabilirdi

Elimdeki dosya burada örneklediğimden çok çok uzun.
OK, uzun ...

Amacım 2.xls dosyasındaki her evrak nosu için bir sheet açmak ve
OK açarız

D sütunundaki her kod için F sütunundaki adet kadar 1.xls dosyasından sıra ile veri taşımak.
Nereye taşınacak? Neye göre taşınacak? Örneğin B33 yazan kod'un karşısında adet olarak 10 girilmiş ... Bunu örnekleyiniz.

Ama burdaki en önemli durum;
Önemli bir şey geliyor ...

taşınan satırların çıkış tarihlerinin
Taşıyabilme Şifresini bir çözsek, sorun kalmayacak zaten de ...

2.xls dosyasının 1.sayfasındaki dosya tarihinden 3gün büyük olmasıdır.
Anlamadım ...

Örnek olması açısından 2.xls dosyasında 22777 sheetine bakabilirsiniz.
Baktım ama birşey anlamadım.

Lütfen, bilmece gibi sorular sormayınız. Mümkün olduğu kadar, örneklerle (hücre referansları, kriterler, yerler vs) açıklayınız.

 

[reckly]

Merhabalar

Yani, bir insanın kafası anca bu kadar karıştırılabilirdi

Elimdeki dosya burada örneklediğimden çok çok uzun.
OK, uzun ...

Amacım 2.xls dosyasındaki her evrak nosu için bir sheet açmak ve
OK açarız

D sütunundaki her kod için F sütunundaki adet kadar 1.xls dosyasından sıra ile veri taşımak.
Nereye taşınacak? Neye göre taşınacak? Örneğin B33 yazan kod'un karşısında adet olarak 10 girilmiş ... Bunu örnekleyiniz.

Ama burdaki en önemli durum;
Önemli bir şey geliyor ...

taşınan satırların çıkış tarihlerinin
Taşıyabilme Şifresini bir çözsek, sorun kalmayacak zaten de ...

2.xls dosyasının 1.sayfasındaki dosya tarihinden 3gün büyük olmasıdır.
Anlamadım ...

Örnek olması açısından 2.xls dosyasında 22777 sheetine bakabilirsiniz.
Baktım ama birşey anlamadım.

Lütfen, bilmece gibi sorular sormayınız. Mümkün olduğu kadar, örneklerle (hücre referansları, kriterler, yerler vs) açıklayınız.

Sayın FPC,
Kesinlikle çok haklısınız. Konuyu bilmeyen biri için çok anlamsız yazmışım Uzunca açıklamanız için teşekkür.
Anlatmak istediğim şey şu idi:
1.xls dosyasında, A1 malzemesi kullanılarak işlem görmüş bildirim listesi mevcut. Bu listeyi tekrar sıralamak istiyorum. Sıralama şöyle olmalı: önce 2.xls dosyasındaki sayfa1'de K sütunundaki her ayrı değer için ayrı sheet açmalıyım(örnek 22777). Bu K sütunundaki değere göre (örneğin 22777 sayfasına yazılmak üzere) D sütunundaki her kod için F sütunundaki adet kadar 1.xls dosyasındaki "bildirim"lerden aktarma yapmalıyım. Buradaki sorunum şu, taşınan bildirimlerin "çıkış tarihleri" o malzemenin 2.xls (sayfa1) deki "dosya tarihinden" 3 gün sonra olmalı. Dosyada daha da açık bir şekilde açıklama yaptım.
Bu aktarma mümkün mü?

 

[reckly]

Yetetirince açıklayıcı olmuş mu?

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodları, 2.xls kitabında standart bir modül oluşturup kopyalarınız.

Sub DerleToparla()
Dim wb1 As Workbook
Dim sh1 As Worksheet, sh As Worksheet, shT As Worksheet, wsh As Worksheet
Dim shO As Worksheet
Dim y%, i%, j%, x%, ss%
Dim arrSayfa(), arrBaslik()
Set wb1 = Workbooks("1.xls")
Set wsh = wb1.Sheets("Sayfa1")
Set sh1 = ThisWorkbook.Sheets("Sayfa1")
arrBaslik = Array("Malzeme", "Tanım", "Bildirim", "Giriş Tarih", "Çıkış Tarih", "Bölge", "Seri", "Müşteri", "Adres", "Kent", "Telefon", "Sipariş")
y = 1
ReDim Preserve arrSayfa(1 To y)
arrSayfa(y) = sh1.Cells(2, 11)
For i = 2 To sh1.Cells(65536, 1).End(xlUp).Row
    For j = 1 To UBound(arrSayfa)
        If sh1.Cells(i, 11) = arrSayfa(j) Then: x = x + 1
    Next j
    If x = 0 Then
       y = y + 1
       ReDim Preserve arrSayfa(1 To y)
       arrSayfa(y) = sh1.Cells(i, 11)
    End If
    x = 0
Next i
For i = 1 To UBound(arrSayfa)
    For Each sh In ThisWorkbook.Sheets
        If arrSayfa(i) = sh.Name Then: x = x + 1
    Next
    If x > 0 Then
        ThisWorkbook.Sheets(Trim(arrSayfa(i))).Cells.ClearContents
        For j = 2 To 13: ThisWorkbook.Sheets(Trim(arrSayfa(i))).Cells(1, j) = arrBaslik(j - 2): Next
    Else
        Set shT = ThisWorkbook.Sheets.Add
        shT.Name = arrSayfa(i)
        For j = 2 To 13: shT.Cells(1, j) = arrBaslik(j - 2): Next
    End If
    Set shT = Nothing
    x = 0
Next i
For i = 2 To sh1.Cells(65536, 1).End(xlUp).Row
    For j = 2 To wsh.Cells(65536, 1).End(xlUp).Row
        If wsh.Cells(j, 11) = sh1.Cells(i, 4) Then
           If wsh.Cells(j, 2) >= sh1.Cells(i, 2) + 3 Then
              Set shO = ThisWorkbook.Sheets(Trim(sh1.Cells(i, 11)))
              ss = shO.Cells(65536, 2).End(xlUp).Row + 1
              If Application.WorksheetFunction.CountIf(shO.Range("B2:B" & ss), sh1.Cells(i, 4)) > sh1.Cells(i, 6) Then: Exit For
              shO.Cells(ss, 2) = wsh.Cells(j, 11)
              shO.Cells(ss, 3) = wsh.Cells(j, 12)
              shO.Cells(ss, 4) = wsh.Cells(j, 1)
              shO.Cells(ss, 5) = wsh.Cells(j, 2)
              shO.Cells(ss, 6) = wsh.Cells(j, 3)
              shO.Cells(ss, 7) = wsh.Cells(j, 4)
              shO.Cells(ss, 8) = wsh.Cells(j, 5)
              shO.Cells(ss, 9) = wsh.Cells(j, 6)
              shO.Cells(ss, 10) = wsh.Cells(j, 7)
              shO.Cells(ss, 11) = wsh.Cells(j, 8)
              shO.Cells(ss, 12) = wsh.Cells(j, 9)
              shO.Cells(ss, 13) = wsh.Cells(j, 10)
           End If
       End If
    Next j
Next i
End Sub

 

[reckly]

Sayın Fpc,

Öncelikle emeğiniz, sabrınız ve yardımınız için çok teşekkürler.
Overflow hatası alıyorum. Neyi yanlış yaptığımı söyleyebilir misiniz? Yoksa dosyayı mı görmelisiniz?

Teşekkürler.

Not: Sayın Fpc,

Aktarma işleminde adet sapması var.Neden olabilir? Nereyi kontrol etmeliyim?

 

[Ferhat Pazarçevirdi]

Overflow bir taşma (sınırı aşma) hatasıdır.

Yani müstakil ev ruhsatı almış bir temele, gökdelen dikmeye benzer.

Değişkenlerden birine veya birkaçına, kaldırabileceğinden daha fazla yük bindirişmişizdir.

6 Nolu gönderdiğiniz mesajdaki dosyaya bu kodları uyarladığınızda mı sorunla karşılaştınız? Yoksa orjinal dosyaya (çok verili) uyguladığınızda mı?

Hangi satırda hata verdiğini de lütfen bildirin.

 

[reckly]

6 nolu gönderdiğim mesajdaki dosyada sorunsuz çalışıyor. Uygulamaya çalıştığım dosyada hata veriyor. Değişkenlerdeki sınırlara bakayım. Umarım anlarım Teşekkürler.