Sub aliB()
Dim cel As Range
Dim ACODE(), BCODE(), CCODE(), DCODE()
ReDim ACODE(0): ReDim BCODE(0): ReDim CCODE(0): ReDim DCODE(0)
sherkat = Sheet2.Range("B1")
A = Sheet2.Range("A3")
B = Sheet2.Range("A4")
C = Sheet2.Range("A5")
D = Sheet2.Range("A6")
For Each cel In Sheet1.Range("A2:A6")
If cel = sherkat Then
code = cel.Offset(, 1).Value
items = Split(cel.Offset(, 2).Value, "-")
Price = Split(cel.Offset(, 3).Value, "-")
For i = LBound(items) To UBound(items)
Select Case items(i)
Case A
ASUM = ASUM + CInt(Price(i))
ACODE(UBound(ACODE)) = code
ReDim Preserve ACODE(UBound(ACODE) + 1)
Case B
BSUM = BSUM + CInt(Price(i))
BCODE(UBound(BCODE)) = code
ReDim Preserve BCODE(UBound(BCODE) + 1)
Case C
CSUM = CSUM + CInt(Price(i))
CCODE(UBound(CCODE)) = code
ReDim Preserve CCODE(UBound(CCODE) + 1)
Case D
DDSUM = DDSUM + CInt(Price(i))
DCODE(UBound(DCODE)) = code
ReDim Preserve DCODE(UBound(DCODE) + 1)
End Select
Next i
End If
Next cel
If UBound(ACODE) > 0 Then ReDim Preserve ACODE(UBound(ACODE) - 1)
If UBound(BCODE) > 0 Then ReDim Preserve BCODE(UBound(BCODE) - 1)
If UBound(CCODE) > 0 Then ReDim Preserve CCODE(UBound(CCODE) - 1)
If UBound(DCODE) > 0 Then ReDim Preserve DCODE(UBound(DCODE) - 1)
Sheet2.Range("B3") = ASUM
Sheet2.Range("B4") = BSUM
Sheet2.Range("B5") = CSUM
Sheet2.Range("B6") = DDSUM
Sheet2.Range("C3") = Join(ACODE, "-")
Sheet2.Range("C4") = Join(BCODE, "-")
Sheet2.Range("C5") = Join(CCODE, "-")
Sheet2.Range("C6") = Join(DCODE, "-")
End Sub
کامنت