Hatırlatma programı foruma eklenmiştir.
http://www.excelce.net/forum/index.php?topic=1661.0

Gönderen Konu: SAYFALARDAN MAKRO İLE KOŞULLU OLARAK DÖKÜM ALMAK  (Okunma sayısı 3701 defa)

0 Üye ve 1 Ziyaretçi konuyu incelemekte.

Çevrimdışı ayyıldız05

  • Excelce Onbaşı
  • **
  • İleti: 12
  • Puan +0/-0
  • Cinsiyet: Bay
  • Excel'den Daha Fazlası!..
  • Ad Soyad: ihsan görgülü
  • Doğum Yılınız: 1981
  • İl / İlçe: ankara beypazarı
  • İşletim Sisteminiz: xp sp3
  • Mesleğiniz: kamu
  • Office Versiyonunuz: oficce 2003
Arkadaşlar selamlar.Ekteki dosyada 1-8-9-MTS olarak 4 sayfam var. A44-AG147 aralığındaki 26 bölümlük veri girişlerinden 1.güne ait ilk 3 veri girişini örnek olarak doldurdum.Bunu ay boyunca gün gün her ekip için işlemekteyim. İstediğim madde ve araç cinsini eşleştirerek döküm sayfasına 4 ekibinkini toplam olarak ilgili haneye atsın. Yanı 13. madde otomobil ise Döküm sayfasına 13 ve otomobil sütununun kesiştiği hücreye atsın, eğer 14 madde Otobüs seçilmişse döküm sayfasında ilgili hücreye toplam atsın. Bu arada  eski sayfamda bunu yapabiliyordum bunu da örnek olarak AJ2-AU74 aralığında gösterdim. Bunu aşağıdaki kod ile alabiliyordum. Yani veri girişi çizelgem önceden AJ2-AU74 aralığında gösterdiğim çizelge gibiydi.Ama çizelgeyi değiştirdiğimden a44-ag147 aralığındaki 26 bölümlük girişten nasıl alabilirim. Yardımcı olabilirseniz sevinirim.

Önceki çizelgemdeki 31 günlük sayfadan aldığımda kod;

Sub icmal()

    Set sT = Sheets("DÖKÜM")
    Dim w(1 To 232, 1 To 11)
    sayfalar = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31")
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For i = 5 To 232
            .Add Trim(sT.Cells(i, 1).Value), i - 4
        Next i

        For i = 0 To 30
            Set sv = Sheets(sayfalar(i))
            For ii = 46 To 75
                key = Trim(sv.Cells(ii, 5).Value)
                If key <> "" Then
                    If .Exists(key) Then
                        sat = .Item(key)
                        Select Case sv.Cells(ii, 8).Value
                        Case "MOTOSİKLET": sut = 1
                        Case "MOTORLUBİSİKLET": sut = 2
                        Case "OTOMOBİL": sut = 3
                        Case "MİNİBÜS": sut = 4
                        Case "KAMYONET": sut = 5
                        Case "KAMYON": sut = 6
                        Case "OTOBÜS": sut = 7
                        Case "TRAKTÖR": sut = 8
                        Case "ÇEKİCİ": sut = 9
                        Case "TANKER": sut = 10
                        Case Else: sut = 11
                        End Select
                    Else
                        MsgBox "Hatalı Madde Kodu... "
                        sv.Cells(ii, 1).Select
                        Exit Sub
                    End If
                    w(sat, sut) = w(sat, sut) + 1
                End If
            Next ii
        Next i
        sT.Range("B5:L232").Value = w
    End With
End Sub

Private Sub CommandButton1_Click()
Sayfa32.PrintPreview
End Sub

Private Sub Worksheet_Activate()
    Call icmal
End Sub