• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Filtre kriterini otomatik seçtirmek?

K

KDracula

Katılım
12 Ekim 2009
Mesajlar
11
Excel Vers. ve Dili
Excel 2007
İngilizce
Merhaba,

Elimde 12 ayrı sayfa ve her sayfada ortalama 15000 girdiden oluşan bir data var. Datalar özetle bir şehirden başka bir şehire gönderilen ürünlerle ilgili. Yapmam gereken ise şu: Her gönderi için 38 kolon yani 38 farklı bilgi var. Benim ilgilendiğim ise 3 bilgi. Gönderi şehri, gönderildiği şehir ve ürün çeşidi. Bunlara göre filtreleme yaptıktan sonra gerekli işlemleri yapan bir macro yazdım ama bana lâzım olan filtreleme işini de otomatik yapması. Kısaca önce 1. filtrelemeyi uygulayıp gönderinin yapıldığı şehri seçecek, o sabitken 2. filtreye başlayacak. 2. filtreyle beraber 3. filtre de çalışacak. 2 ve 3 tamamlanınca 1. filtre diğer şehre geçecek. Mümkün müdür, değil midir bilmiyorum ama ihtiyacım olan bu. Yardım edebilirseniz çok sevinirim. Bu sorunuma benzer bir mesaj var mı diye baktım ama bulamadım, varsa kusuruma bakmayın.

Şimdiden teşekkürler...
 
Çok teşekkür ederim, sorunumu çözdüm. Bilen birinden daha yardım aldım, bir makro hazırladım ama şu an 50 satır için sorunsuz çalışırken, 100 satırlık bir kısımla ilgili çalıştığı zaman saatler sürüyor. Hata vermiyor ama bu kadar uzun çalışması bana mantıklı gelmedi. Bununla ilgili bir öneriniz olabilir mi? Sorun bilgisayarda mıdır, yoksa durum normal midir?

Teşekkür ederim tekrar.
 
Filtre

Sayın Arkadaşım,

Bu konularda daha fazla yardımcı olabilmek için dosyanın yayınlanması uygun olacaktır.

Mümkünse dosyayı yayınlayınlayın bir sakıncası yoksa yardımcı olmak daha kolay oluyor.

Saygılar.

İsmet
 
Merhaba;

Dosyayı yayınlamak sıkıntı olabilir, ama ben arkadaşımın yazdığı kodu göndereyim. Umarım bir çözümü bulunabilir. İlginiz için teşekkürler.

Kod: 
Sub new_code()

' Here are some variables we use
Dim num_rows As Integer
Dim stopper As Boolean
'Dim product_depart, product_destin, product_id  'these are the arrays with uniqe (not multiple) data
Dim supplier, origin, destination, order_type, type_of_good

Dim primat  'temporary array
'Dim product_sum As Integer
Dim no_of_piece_sum As Integer
Dim no_of_pallete_sum As Integer
Dim actual_weight_sum As Integer
Dim chargeable_weight_sum As Integer


' It is wise to set the colums that hold data at this point. At least easier then doing it within the script :)

data_sheet = "sheet1"
supplier_col = 1          ' i.e. first column in the worksheet
origin_col = 9
destination_col = 11
order_type_col = 35
type_good_col = 36
number_of_piece_col = 16
number_of_palette_col = 17
total_actual_weight_col = 18
total_chargeable_weight_col = 19


' Here are the default values for some variables
stopper = False

ReDim supplier(1)
ReDim origin(1)
ReDim destination(1)
ReDim order_type(1)
ReDim type_of_good(1)

'***** Here starts the main routine *****
Application.ScreenUpdating = False



' lets see how many rows we have...
Do
    num_rows = num_rows + 1
    Set curcell = Worksheets(data_sheet).Cells(num_rows, 1)
Loop Until curcell = ""

num_rows = num_rows - 1 ' (-1) for excess counting

'Worksheets("Sheet2").Cells(1, 1) = "#ROWS"
'Worksheets("Sheet2").Cells(1, 2) = num_rows


' Now.. let's read the data in the colums and insert them to corresponding arrays

For row_count = 1 To num_rows

    ' We need to RESET these variables, else, once they are set FALSE, they stay so all the time.
    insert_supplier = True
    insert_origin = True
    insert_destination = True
    insert_order_type = True
    insert_type_of_good = True


    ' Here we read data from ROW
    temp_supplier = Worksheets(data_sheet).Cells(row_count, supplier_col).Value
    temp_origin = Worksheets(data_sheet).Cells(row_count, origin_col).Value
    temp_destination = Worksheets(data_sheet).Cells(row_count, destination_col).Value
    temp_order_type = Worksheets(data_sheet).Cells(row_count, order_type_col).Value
    temp_type_of_good = Worksheets(data_sheet).Cells(row_count, type_good_col).Value
    
    ' This is a somewhat stupid line to assign the very first values to arrays, else
    ' we will have the first member of each array empty. Lets hope the first row does not have
    ' an epmy element :)
    If row_count = 1 Then
        supplier(1) = temp_supplier
        origin(1) = temp_origin
        destination(1) = temp_destination
        order_type(1) = temp_order_type
        type_of_good(1) = temp_type_of_good
    End If
    
    
    ' Here we check if the same data exists previously in the cooresponding array
    For i = 1 To UBound(supplier)
        If temp_supplier = supplier(i) Then
            insert_supplier = False                       ' if same data exists, then do not insert new data to array
        End If
    Next i
        
    For i = 1 To UBound(origin)
        If temp_origin = origin(i) Then
            insert_origin = False
        End If
    Next i
        
    For i = 1 To UBound(destination)
        If temp_destination = destination(i) Then
            insert_destination = False
        End If
    Next i
     
    For i = 1 To UBound(order_type)
        If temp_order_type = order_type(i) Then
            insert_order_type = False
        End If
    Next i
        
    For i = 1 To UBound(type_of_good)
        If temp_type_of_good = type_of_good(i) Then
            insert_type_of_good = False
        End If
    Next i
        
    ' Here we insert the new data into the corresponding array, if it does not exist already.
    
    If insert_supplier = True Then
        ReDim primat(0)                               ' erase the existing data in temp. array
        ReDim primat(UBound(supplier))                ' set the temporary array to correct size
        primat = supplier                             ' put the data into temp. array
        ReDim supplier(UBound(supplier) + 1)          ' increase size +1 (this step erases the existing data)

        For i = 1 To UBound(supplier) - 1
            supplier(i) = primat(i)                   ' recover the erased data by REDIM
        Next i

        supplier(UBound(supplier)) = temp_supplier    ' and add the new data to array
    End If
    
    If insert_origin = True Then
        ReDim primat(0)
        ReDim primat(UBound(origin))
        primat = origin
        ReDim origin(UBound(origin) + 1)

        For i = 1 To UBound(origin) - 1
            origin(i) = primat(i)
        Next i

        origin(UBound(origin)) = temp_origin
    End If
    
    If insert_destination = True Then
        ReDim primat(0)
        ReDim primat(UBound(destination))
        primat = destination
        ReDim destination(UBound(destination) + 1)

        For i = 1 To UBound(destination) - 1
            destination(i) = primat(i)
        Next i

        destination(UBound(destination)) = temp_destination
    End If
    
    If insert_order_type = True Then
        ReDim primat(0)
        ReDim primat(UBound(order_type))
        primat = order_type
        ReDim order_type(UBound(order_type) + 1)

        For i = 1 To UBound(order_type) - 1
            order_type(i) = primat(i)
        Next i

        order_type(UBound(order_type)) = temp_order_type
    End If

    If insert_type_of_good = True Then
        ReDim primat(0)
        ReDim primat(UBound(type_of_good))
        primat = type_of_good
        ReDim type_of_good(UBound(type_of_good) + 1)

        For i = 1 To UBound(type_of_good) - 1
           type_of_good(i) = primat(i)
        Next i

        type_of_good(UBound(type_of_good)) = temp_type_of_good
    End If

Next row_count



'MsgBox ("OK")

' Lets check if everything works fine comment/uncomment below

'For i = 1 To UBound(product_depart)
'    Worksheets("sheet3").Cells(i, 1).Value = product_depart(i)
'Next i
'
'For i = 1 To UBound(product_destin)
'    Worksheets("sheet3").Cells(i, 2).Value = product_destin(i)
'Next i
'
'For i = 1 To UBound(product_id)
'    Worksheets("sheet3").Cells(i, 3).Value = product_id(i)
'Next i


' At the moment we have all the data we need,
' all we need to do is to catagorize them and take the sum of the products
' preferably to new worksheet called "report"

Sheets.Add After:=Sheets(Sheets.Count)
Set ReportSheet = ActiveSheet
ReportSheet.Name = "Report"



For supplier_count = 1 To UBound(supplier)

    For origin_count = 1 To UBound(origin)

        For destination_count = 1 To UBound(destination)
        
            For type_of_good_count = 1 To UBound(type_of_good)
            
                For order_type_count = 1 To UBound(order_type)
                     
                            no_of_piece_sum = 0
                            no_of_pallete_sum = 0
                            actual_weight_sum = 0
                            chargeable_weight_sum = 0

                            For row_count = 1 To num_rows
                
                                With Worksheets(data_sheet)
                
                                    
                                    'If .Cells(row_count, supplier_col).Value = supplier(supplier_count) Then
                                        'MsgBox ("1")
                                        'If .Cells(row_count, origin_col).Value = origin(origin_count) Then
                                            'MsgBox ("2")
                                            'If .Cells(row_count, destination_col).Value = destination(destination_count) Then
                                                'MsgBox ("3")
                                                'If .Cells(row_count, type_good_col).Value = type_of_good(type_of_good_count) Then
                                                    'MsgBox ("4")
                                                    'If .Cells(row_count, order_type_col).Value = order_type(order_type_count) Then
                                                    
                                    If (.Cells(row_count, supplier_col).Value = supplier(supplier_count) And _
                                        .Cells(row_count, origin_col).Value = origin(origin_count) And _
                                        .Cells(row_count, destination_col).Value = destination(destination_count) And _
                                        .Cells(row_count, type_good_col).Value = type_of_good(type_of_good_count) And _
                                        .Cells(row_count, order_type_col).Value = order_type(order_type_count)) Then
                
                                                        'MsgBox ("sum a geldi")
                                                        no_of_piece_sum = no_of_piece_sum + .Cells(row_count, number_of_piece_col).Value
                                                        no_of_pallete_sum = no_of_pallete_sum + .Cells(row_count, number_of_palette_col).Value
                                                        actual_weight_sum = actual_weight_sum + .Cells(row_count, total_actual_weight_col).Value
                                                        chargeable_weight_sum = chargeable_weight_sum + .Cells(row_count, total_chargeable_weight_col).Value
                
                
                                    End If
                                        
                                                    'End If
                                                'End If
                                            'End If
                                        'End If
                                    'End If
                                    
                
                                End With
                
                            Next row_count
                
                            ii = ii + 1
                            
                            With Worksheets("Report")
                
                                .Cells(ii, 1).Value = supplier(supplier_count)
                                .Cells(ii, 2).Value = origin(origin_count)
                                .Cells(ii, 3).Value = destination(destination_count)
                                .Cells(ii, 4).Value = type_of_good(type_of_good_count)
                                .Cells(ii, 5).Value = order_type(order_type_count)
                                
                                .Cells(ii, 6).Value = no_of_piece_sum
                                .Cells(ii, 7).Value = no_of_pallete_sum
                                .Cells(ii, 8).Value = actual_weight_sum
                                .Cells(ii, 9).Value = chargeable_weight_sum
                
                
                            End With
            
                Next order_type_count
                
            Next type_of_good_count

        Next destination_count

    Next origin_count

Next supplier_count


Application.ScreenUpdating = True


End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst