ebat ölçüleri hk.

[yesilcan]

Arkadaşlar,buraya yazdığım stok numarasına ve adede göre sol tarafta bulunan karelere her kareye ilgili stok numarasına karşılık gelen(stok sheet'de) en ölçülerini yazmasını istiyorum..yardım rica..

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodu standart bir module sayfasına kopyalayıp çalıştırınız veya örnek dosyayı inceleyiniz.

Option Explicit
Sub Miktalari_Dagit()
    
    Dim wksSto As Worksheet
    Dim rng As Range
    Dim dblEn As Double
    Dim i%, j%, iStr%, iSut%
    
    iStr = 1: iSut = 0
    
    With Worksheets("anasayfa")
        
        With .Columns("A:D")
            .ClearContents
            .Interior.ColorIndex = xlNone
        End With
        
        Set wksSto = Worksheets("stok")
        
        For i = 3 To .Cells(65536, 8).End(xlUp).Row
            
            Set rng = wksSto.Columns(1).Find(.Cells(i, 8), Lookat:=xlWhole)
            
            If rng Is Nothing Then
                dblEn = 0
            Else
                If IsNumeric(rng.Offset(0, 2)) Then
                    dblEn = rng.Offset(0, 2)
                Else
                    dblEn = 0
                End If
            End If
                
            If IsNumeric(.Cells(i, 8).Offset(0, 2)) Then
                
                For j = 1 To .Cells(i, 8).Offset(0, 2)
                    If iSut = 3 Then iSut = 1: .Cells(iStr, 4) = iStr: iStr = iStr + 1 Else iSut = iSut + 1
                   .Cells(iStr, iSut) = dblEn
                   .Cells(iStr, iSut).Interior.Color = .Cells(i, 10).Interior.Color
                Next j
            
            Else
                If iSut = 3 Then iSut = 1: .Cells(iStr, 4) = iStr: iStr = iStr + 1 Else iSut = iSut + 1
                .Cells(iStr, iSut) = "Miktar YOK"
            End If
        Next i
    
        .Cells(iStr + 2, 1).Formula = "=SUM(A1:A" & iStr & ")"
        .Cells(iStr + 2, 2).Formula = "=SUM(B1:B" & iStr & ")"
        .Cells(iStr + 2, 3).Formula = "=SUM(C1:C" & iStr & ")"
        
    End With

    Set wksSto = Nothing
    
End Sub

 

[yesilcan]

ilgi ve alakanıza sonsuz teşekkürler