Sayfalara hucre değeri ustunden veri dağıtımında nasıl bir yol izlenmeli ?

[cenderus]

Değerli hocalarım;

sizlere onceki çalışmamda verdiğiniz destek için çok teşekur ederim;

yeni çalışmamabaşlamak için uzun zaman duşundum ama nasıl bir başlangıç yapacağım konusunda sonuç alamadım,

Yapmak istediğim ;

Belli kriterler dahilinde ;

Hucre değerini analiz edip kriterde belirtilen sayfaya kopyalayacak ama bunu yaparken beraberinde her seferinde barkodu-urun adını ve metin1 metin surundaki karşılığınıda kopyalacak

A sutunu barcodları
B sutunu Urun adını

C-D-E-F sutunları verilerin işlendiği hucreleri içieriyor

G ve H ise farklı metinler içeriyor

C-D-E-F ye girilmiş herhangi bir sayı kriterde belirtilen çalışma sayfasına aynı sutunda aktarılırken yanında A B G H de kopyalanmalı

ama çoğunlukla C-D-E-F stunlarında aynı satırda birden fazla hucrede veri oluyor bu nedenle her hucre değeri ayrı değerlendirilmeli ama bir satırdan bir hucre bir sayfaya aktarılacaksa mutlaka A B G H de kopyalanmalı


Kritere gore sayfalara veri dağıtımı konusunda bana ne oneriyorsunuz ustunde gidebileceğim bir yol verirmisiniz

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodları, standar Module sayfasına kopyalayarak, "BarCodelari_Dagit" makrosunu çalıştırınız.

Örneği de inceleyiniz.

Option Explicit
Dim col As Collection
'---------------------------
Sub BarCodelari_Dagit()
    Dim i As Integer
    Dim iSon As Integer
    Dim iSonSh As Integer
    Dim sh As Worksheet
    Dim rngHcr As Range
    
    Call Sayfalari_Temizle
    
    Set col = New Collection
    
    Call Col_Olustur
    
    
    iSon = Cells(65536, 1).End(xlUp).Row
    
    On Error Resume Next
    
    Application.Calculation = xlCalculationManual
    
    For Each rngHcr In Range("C3:F" & iSon).Cells
        If Len(rngHcr) > 0 Then
            Set sh = Sheets(col(CStr(rngHcr)))
            If Not sh Is Nothing Then
                With sh
                    iSonSh = .Cells(65536, 1).End(xlUp).Row + 1
                    Range("A" & rngHcr.Row & ":H" & rngHcr.Row).Copy .Range("A" & iSonSh & ":H" & iSonSh)
                    .Range("C" & iSonSh & ":F" & iSonSh).ClearContents
                    .Cells(iSonSh, rngHcr.Column) = rngHcr
                End With
            End If
        End If
    Next
    
    Application.Calculation = xlCalculationAutomatic
    
    On Error GoTo 0
    MsgBox "İşlem tamamlandı ...", vbInformation, "Bilgilendirme"
    
    Set col = Nothing
    Set sh = Nothing
    
End Sub
'------------------------
Private Sub Col_Olustur()
    With col
        .Add "a Form", "1"
        .Add "a Form", "2"
        .Add "a Form", "3"
        .Add "a Form", "5"
        .Add "a Form", "7"
        .Add "a Form", "8"
        .Add "a Form", "9"
        .Add "a Form", "15"
        .Add "a Form", "18"
        .Add "b Form", "4"
        .Add "b Form", "10"
        .Add "b Form", "11"
        .Add "b Form", "12"
        .Add "b Form", "13"
        .Add "b Form", "14"
        .Add "b Form", "20"
        .Add "c Form ", "6"
        .Add "c Form ", "16"
        .Add "c Form ", "17"
        .Add "d Form ", "19"
    End With
End Sub
'--------------------------------
Private Sub Sayfalari_Temizle()
    Dim sh As Worksheet
    Dim rg As Range
    
    Application.Calculation = xlCalculationManual
    
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "Genelliste" Then
            Set rg = sh.Range("A3:H" & sh.UsedRange.Row + sh.UsedRange.Rows.Count)
            rg.ClearContents
        End If
    Next
    
    Application.Calculation = xlCalculationAutomatic
    
    Set rg = Nothing
End Sub

 

[cenderus]

tesekkurler hocam

tesekkurler hocam

mukemmel olmus elinize emeğinize sağlık;

bu arada forumun yaşadığı saldırıyı kınıyorum bu kadar insanın yardım aldığı bir foruma kim ne amaçla saldırır anlamadım , eski konu başlıklarına ulaşamayınca doğru durust kaynakta kalmadı elimizde, eski konu başlıkları tekrar yuklenmesi sozkonusumu acaba?

elimde bayağı bir kod birikmişti eger gecmis verilere ulaşılamıyorsa araştırma sırasında sayfaları kaydetmiştim gerek duyarsanız ziplayip elimdekileri foruma yukelemeye yada sizin belirteceğiniz bir maile filan atarım,

saygılarımla

 

[cenderus]

çözüldü

hocam çözüldü onayı kaldırılmış sanırım konuyu kapatmalımıyım yoksa modlarmı artık konuya çözüldü başlığı kendisimi atıyor,

 

[Ferhat Pazarçevirdi]

cenderus, hassasiyetin için teşekkürler ... Esas sorunumuz, şu ana kadar eklenen dosyaların silinmiş olması ... Mesajların tamamına yakını duruyor ... Eğer, elinizde hangi mesaja ait olduğunu bildiğiniz örnek dosyalar varsa; ilgili konunun altına bu dosyayı ekleyip, katkıda bulunabilirsiniz.

NOT : [Çözüldü] işaretlemesini kaldırdık. Bundan sonra, ikinci bir karara kadar kullanılmayacak..

 

[cenderus]

hocam hemen yuklemeye başlıyorum

hocam mesaj sayflarını aynen kaydettiğim için ufak bir uğraşla hepsini yerli yerine yuklerim hem sorudaki orneği hemde gelen cevaptaki ornek dosyaları yuklemeye başlıyorum haftasonu elimdekirlerin hepsi bitmiş olur hocam