dimanche 18 mars 2018

Sum the product of the number of times a string occurs by cell value in loop

I'm new to VBA and I've been stuck with this for a while.

What I'm trying to do is to multiply the value in column A by the number of times a string occurs ie: a, b and c (in range B:D). Then sum that result with next row's result only if they share the same value in column E.

The number of times the a value is repeated in column E will vary from 1 to 30.

This is what I have so far

Sub MYSUB()
Dim ws_1 As Worksheet
Set ws_1 = Sheets("Sheet1")
Dim b1 As Long, b2 As Long, b3 As Long
Dim j As Long
lr = ws_1.Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To lr

datei = ws_1.Cells(r, 5)
dayi = Day(datei)
a = Application.WorksheetFunction.CountIfs(ThisWorkbook.Sheets("Sheet1").Range("t_tb"), "=" & CDbl(datei)) '''

For x = 1 To 3
If dayi = x Then

myrng = "B" & r & ":D" & r

b1 = Application.WorksheetFunction.CountIfs(ThisWorkbook.Sheets("Sheet1").Range(myrng), "=" & "a")
b2 = Application.WorksheetFunction.CountIfs(ThisWorkbook.Sheets("Sheet1").Range(myrng), "=" & "b")
b3 = Application.WorksheetFunction.CountIfs(ThisWorkbook.Sheets("Sheet1").Range(myrng), "=" & "c")

If b1 > 0 Then ws_1.Cells(x + 1, 8) = b1 * ws_1.Cells(r, 1)
If b2 > 0 Then ws_1.Cells(x + 1, 9) = b2 * ws_1.Cells(r, 1)
If b3 > 0 Then ws_1.Cells(x + 1, 10) = b3 * ws_1.Cells(r, 1)

End If
If dayi = x Then GoTo NxtR
Next x

NxtR:
Next r

End Sub

expl

Aucun commentaire:

Enregistrer un commentaire