ח' שואל:
יש לי קובץ אקסל גדול שבעמודה A יש לדוגמא 1000 תאים, שבכל תא יש כמה מוצרים מופרדים בפסיק,ואני רוצה שבעמודה B יהיה ערך מספרי לכל מוצר דרך פונקציית SWITCH , לא על כל התא ביחד,
אלא על כל תא כמה פעמים לפי מספר הנתונים שיש בו, והתוצאה תהיה סכום הכולל יחד,
השאלה אם יש כזה דרך בVBA או משהו כזה.
תודה
תשובה:
ניתן לממש את המבוקש על ידי שימוש בקוד VBA.
בקובץ אקסל נגדיר גיליון "מוצרים" הכולל עמודת מוצרים, מחירים וסך מחיר.
המטרה היא שבעמודת מוצרים תופיע בכל תא רשימת מוצרים מופרדים בפסיק ובעמודת סך מחיר יופיע סך המחיר של המוצרים.
נגדיר גיליון "מחירים" הכולל עמודת "מוצר" ועמודת "מחיר" שבו לכל מוצר יוגדר המחיר שלו.
נפתח את עורך קוד VBA ונוסיף מודול חדש שבו נגדיר את הפונקציה הבאה המקבלת כפרמטר שם מוצר, מחפשת אותו בגיליון מחירים ומחזירה את המחיר שלו.
Public Function calculateProductPrice(strProductName As String) As Double
Dim lngCurRow As Long
Dim intProductsCol As Integer, intPriceCol As Integer
Dim strCurProductName As String
calculateProductPrice = 0
With Sheets("מחירים")
lngCurRow = 2
intProductsCol = 1
intPriceCol = 2
While .Cells(lngCurRow, intProductsCol) <> ""
strCurProductName = .Cells(lngCurRow, intProductsCol)
If strCurProductName = strProductName Then
calculateProductPrice = .Cells(lngCurRow, intPriceCol)
Exit Function
End If
lngCurRow = lngCurRow + 1
Wend
End With
End Function
Dim lngCurRow As Long
Dim intProductsCol As Integer, intPriceCol As Integer
Dim strCurProductName As String
calculateProductPrice = 0
With Sheets("מחירים")
lngCurRow = 2
intProductsCol = 1
intPriceCol = 2
While .Cells(lngCurRow, intProductsCol) <> ""
strCurProductName = .Cells(lngCurRow, intProductsCol)
If strCurProductName = strProductName Then
calculateProductPrice = .Cells(lngCurRow, intPriceCol)
Exit Function
End If
lngCurRow = lngCurRow + 1
Wend
End With
End Function
נוסיף שגרה נוספת העוברת על התאים בעמודה A בגיליון מוצרים, בכל תא מפרידה את שמות המוצרים, מחשבת לכל מוצר את המחיר ומעדכנת בעמודה B את
רשימת המחירים של המוצרים ובעמודה C את סך המחיר של המוצרים.
Public Sub calculatePrices()
Dim strCurProductName As String, lngCurRow As Long
Dim intProductsCol As Integer, intPricesCol As Integer
Dim intTotalPriceCol As Integer, strPrices As String
Dim dblTotalPrice As Double, strProducts As String
Dim arrProducts As Variant, dblCurProductPrice As Double
With Sheets("מוצרים")
lngCurRow = 2
intProductsCol = 1
intPricesCol = 2
intTotalPriceCol = 3
While .Cells(lngCurRow, intProductsCol) <> ""
strPrices = ""
dblTotalPrice = 0
strProducts = .Cells(lngCurRow, intProductsCol)
arrProducts = Split(strProducts, ",")
For lngCurArrIndex = 0 To UBound(arrProducts)
strCurProductName = Trim(arrProducts(lngCurArrIndex))
dblCurProductPrice = calculateProductPrice(strCurProductName)
strPrices = strPrices & IIf(strPrices <> "", ",", "") & dblCurProductPrice
dblTotalPrice = dblTotalPrice + dblCurProductPrice
Next lngCurArrIndex
.Cells(lngCurRow, intPricesCol) = strPrices
.Cells(lngCurRow, intTotalPriceCol) = dblTotalPrice
lngCurRow = lngCurRow + 1
Wend
End With
End Sub
Dim strCurProductName As String, lngCurRow As Long
Dim intProductsCol As Integer, intPricesCol As Integer
Dim intTotalPriceCol As Integer, strPrices As String
Dim dblTotalPrice As Double, strProducts As String
Dim arrProducts As Variant, dblCurProductPrice As Double
With Sheets("מוצרים")
lngCurRow = 2
intProductsCol = 1
intPricesCol = 2
intTotalPriceCol = 3
While .Cells(lngCurRow, intProductsCol) <> ""
strPrices = ""
dblTotalPrice = 0
strProducts = .Cells(lngCurRow, intProductsCol)
arrProducts = Split(strProducts, ",")
For lngCurArrIndex = 0 To UBound(arrProducts)
strCurProductName = Trim(arrProducts(lngCurArrIndex))
dblCurProductPrice = calculateProductPrice(strCurProductName)
strPrices = strPrices & IIf(strPrices <> "", ",", "") & dblCurProductPrice
dblTotalPrice = dblTotalPrice + dblCurProductPrice
Next lngCurArrIndex
.Cells(lngCurRow, intPricesCol) = strPrices
.Cells(lngCurRow, intTotalPriceCol) = dblTotalPrice
lngCurRow = lngCurRow + 1
Wend
End With
End Sub
להפעלת חישוב המחירים נלחץ על "חשב מחירים" והתוצאה היא שבעמודת מחירים יופיעו מחירי המוצרים מופרדים בפסיק ובעמודת סך מחיר יופיע סך המחיר.
בברכה,
צוות אניפיט