Macro que cuente dando opciones de rangos de fechas

Podrías enviarme tu archivo con ejemplos de tus 2 hojas, me perdí un poco en tu explicación y la información que pusiste en los ejemplos, no entendí si hay que buscar en la columna A o en la B.

También en el ejemplo que me envíes puedes completar el promedio de unos materiales. Por ejemplo, si encuentro el material y está en el rango de fechas, pero en cantidad tiene 0, ¿cuenta para el promedio?

Hola, disculpa que te envíe mi archivo tan tarde pero ya quedó. Te puse algunos ejemplos en rojo de los resultados que debería dar el macro. Ojalá se pueda que de las cantidades redondeadas de modo que si es 1655 sea 16660, o si es 1612 sea 1620.

Saludos

Prueba la siguiente macro en tu archivo

Sub stock()
'Por.Dante Amor
    Dim f1 As Date, f2 As Date
    Application.ScreenUpdating = False
    Set h1 = Sheets("PEDIDOS 2013")
    Set h2 = Sheets("STOCK CORRUBOX")
    sem = InputBox("Introduce el número de semestre" & vbCr & vbCr & _
                   "1 para el semestre de Enero-Junio" & vbCr & vbCr & _
                   "2 para el semestre de Julio-Diciembre")
    If sem = "" Then Exit Sub
    Select Case Val(sem)
        Case 1
            f1 = DateSerial(2013, 1, 1)
            f2 = DateSerial(2013, 6, 30)
        Case 2
            f1 = DateSerial(2013, 7, 1)
            f2 = DateSerial(2013, 12, 31)
        Case Else: Exit Sub
    End Select
    c = 0
    u = h2.Range("A" & Rows.Count).End(xlUp).Row
    Set r = h1.Columns("B")
    For i = 2 To u
        Application.StatusBar = "Procesado: " & i & " de " & u
        Set b = r.Find(h2.Cells(i, "A"), lookat:=xlWhole)
        If Not b Is Nothing Then
            ncell = b.Address
            Do
                If h1.Cells(b.Row, "E") >= f1 And h1.Cells(b.Row, "E") <= f2 Then
                    tot = tot + h1.Cells(b.Row, "C")
                    c = c + 1
                End If
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> ncell
            enteros = Int(tot / c)
            decenas = Int(enteros / 10) * 10
            If decenas < enteros Then decenas = decenas + 10
            h2.Cells(i, "D") = decenas
            c = 0
            tot = 0
        End If
    Next
    Application.ScreenUpdating = True
    Application.StatusBar = False
    MsgBox "Fin de promedios", vbInformation, "Fecha: " & Date
End Sub

La macro te pone la ventana para preguntarte por el semestre, te calcula el promedio por código y redondea el promedio. 

Agregué el estatus de cuántos registros va procesando, lo puedes ver en la parte inferior izquierda de excel.

Saludos. Dante Amor

No olvides valorar la respuesta.

Hola,

Lo pobre con la opcion de fechas 1 en mi archivo y me marca error de "Desbordamiento" en la línea:

enteros = Int ( tot / c )

Lo detengo y solo ha hecho los promedios de 14 (que están bien) y se queda hasta la fila 24 en la que ya no saca nada. Me fijé y se paraba cuando buscaba 206501 que cuando lo busqué en la lista estaba en 0, eliminé esa fila y lo volví a correr pero despues me marcó error al buscar 4041 (fila 64) pero ese si existe una fila con valor en la cantidad de 10 pero con fecha del segundo semestre.

Volví a checar la fila que había eliminado y también era del segundo semestre, por eso creo que falla cuando hay valores de lo que esta buscando pero estos no pertenecen al semestre en el que está buscando.

Espero puedas ayudarme.

Saludos

Lo reviso y te envío la corrección.

Disculpa, ahora sí probé en los 2 semestres.

Va la macro

Sub stock()
'Por.Dante Amor
    Dim f1 As Date, f2 As Date
    Application.ScreenUpdating = False
    Set h1 = Sheets("PEDIDOS 2013")
    Set h2 = Sheets("STOCK CORRUBOX")
    sem = InputBox("Introduce el número de semestre" & vbCr & vbCr & _
                   "1 para el semestre de Enero-Junio" & vbCr & vbCr & _
                   "2 para el semestre de Julio-Diciembre")
    If sem = "" Then Exit Sub
    Select Case Val(sem)
        Case 1
            f1 = DateSerial(2013, 1, 1)
            f2 = DateSerial(2013, 6, 30)
        Case 2
            f1 = DateSerial(2013, 7, 1)
            f2 = DateSerial(2013, 12, 31)
        Case Else: Exit Sub
    End Select
    c = 0
    u = h2.Range("A" & Rows.Count).End(xlUp).Row
    Set r = h1.Columns("B")
    For i = 2 To u
        Application.StatusBar = "Procesado: " & i & " de " & u
        Set b = r.Find(h2.Cells(i, "A"), lookat:=xlWhole)
        If Not b Is Nothing Then
            ncell = b.Address
            Do
                If h1.Cells(b.Row, "E") >= f1 And h1.Cells(b.Row, "E") <= f2 Then
                    tot = tot + h1.Cells(b.Row, "C")
                    c = c + 1
                End If
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> ncell
            If c > 0 Then
                enteros = Int(tot / c)
                decenas = Int(enteros / 10) * 10
                If decenas < enteros Then decenas = decenas + 10
                h2.Cells(i, "D") = decenas
            End If
            c = 0
            tot = 0
        End If
    Next
    Application.ScreenUpdating = True
    Application.StatusBar = False
    MsgBox "Fin de promedios", vbInformation, "Fecha: " & Date
End Sub

Ya quedo excelente, solo te molesto con una ultima cosa, ¿si quisiera que también me saliera una ventana emergente preguntándome el año (para que no siempre sea con 2013) como sería?

Saludos y gracias

El nombre de la hoja también cambiaría a "PEDIDOS + AÑO"