求助大神，求不同日期段平均价和购入平均价

dnvjfdeuff · 发表于 2024-5-21 16:26

tanglf188 · 发表于 2024-5-21 16:56

请参考

dnvjfdeuff · 发表于 2024-5-21 20:32

tanglf188 发表于 2024-5-21 16:56
请参考

大神，我不是这个要求

longwin · 发表于 2024-5-21 22:36

请测试：

wang-way · 发表于 2024-5-21 23:23

你的说法和你的模拟数据对的上？

wang-way · 发表于 2024-5-22 00:15

JSA 练个手 @似水无痕有没有进步不用filter了

//JSA 014 分类求平均
function subtotal2(){
let sht=ThisWorkbook.Worksheets.Item(1);
let ar=sht.Range('a1').CurrentRegion.Value();
let obj=ar.slice(1).reduce((obj,r)=>{
let k=r.slice(0,6).join('-');
console.log(k);
//满足日期条件再操作
if( new Date(r[6])>=new Date('2024-03-26') || new Date(r[6])<=new Date('2024-04-25')){
let t=obj[k]=obj[k]||[...r.slice(0,6),0,0,0,0];//初始化
t[6]+=r[7];//最低价
t[7]=t[7]||r[10];//实购价
t[9]+=1;//计数
}
return obj;
},{})
Object.values(obj).forEach(r=>{
console.log(...r);
r[6]/=r[9];
r[8]=r[6]-r[7];
r.pop();
})
let br=Object.values(obj);
sht.Range('o2').Resize(br.length,br[0].length).Value2=br;
}

复制代码

全党 · 发表于 2024-5-22 06:52

Sub shishi()
Dim brr()
Set d = CreateObject("scripting.dictionary")
arr = Range("a1").CurrentRegion
sd = #3/26/2024#: ld = #4/25/2024#
For i = 2 To UBound(arr)
If CDate(arr(i, 7)) >= sd And CDate(arr(i, 7)) <= ld Then
Key = arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 5) & "," & arr(i, 6)
If Not d.exists(Key) Then
d(Key) = i
Else
d(Key) = d(Key) & "," & i
End If
End If
Next
ReDim brr(1 To d.Count, 1 To 9)
For Each Key In d.keys
n = n + 1: s = 0
tt = Split(Key, ",")
For j = 0 To 5
brr(n, j + 1) = tt(j)
Next
ss = Split(d(Key), ",")
For i = 0 To UBound(ss)
If arr(ss(i), 11) <> 0 Then grjj = arr(ss(i), 11)
s = s + arr(ss(i), 8)
Next
zdjj = s / (UBound(ss) + 1)
brr(n, 7) = Round(zdjj, 2): brr(n, 8) = grjj: brr(n, 9) = Round((zdjj - grjj), 2)
Next
[o8].Resize(n, 9) = brr
End Sub

复制代码

全党 · 发表于 2024-5-22 07:59

三个字典，改了一下。

Sub shsh()
Dim brr()
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
arr = Range("a1").CurrentRegion
sd = #3/26/2024#: ld = #4/25/2024#
For i = 2 To UBound(arr)
If CDate(arr(i, 7)) >= sd And CDate(arr(i, 7)) <= ld Then
Key = arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 5) & "," & arr(i, 6)
If Not d.exists(Key) Then
d(Key) = arr(i, 8): d1(Key) = 1
If arr(i, 11) <> 0 Then d2(Key) = arr(i, 11)
Else
If arr(i, 11) <> 0 Then d2(Key) = arr(i, 11)
d(Key) = d(Key) + arr(i, 8): d1(Key) = d1(Key) + 1
End If
End If
Next
ReDim brr(1 To d.Count, 1 To 9)
For Each Key In d.keys
n = n + 1
tt = Split(Key, ",")
For j = 0 To 5
brr(n, j + 1) = tt(j)
Next
zdjj = d(Key) / d1(Key)
brr(n, 7) = Round(zdjj, 2): brr(n, 8) = d2(Key): brr(n, 9) = Round((zdjj - d2(Key)), 2)
Next
[o15].Resize(n, 9) = brr
End Sub

复制代码

全党 · 发表于 2024-5-22 09:00

全党发表于 2024-5-22 07:59
三个字典，改了一下。

两个字典，再改。。。。

Sub sh()
Dim crr()
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
arr = Range("a1").CurrentRegion
sd = #3/26/2024#: ld = #4/25/2024#
For i = 2 To UBound(arr)
If CDate(arr(i, 7)) >= sd And CDate(arr(i, 7)) <= ld Then
Key = arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 5) & "," & arr(i, 6)
If Not d.exists(Key) Then
d(Key) = Array(arr(i, 8), arr(i, 11)): d1(Key) = 1
Else
d(Key) = Array(d(Key)(0) + arr(i, 8), d(Key)(1) + arr(i, 11)): d1(Key) = d1(Key) + 1
End If
End If
Next
ReDim crr(1 To d.Count, 1 To 9)
For Each Key In d.keys
n = n + 1
tt = Split(Key, ",")
For j = 0 To 5
crr(n, j + 1) = tt(j)
Next
zdjj = d(Key)(0) / d1(Key)
crr(n, 7) = Round(zdjj, 2): crr(n, 8) = d(Key)(1): crr(n, 9) = Round((zdjj - d(Key)(1)), 2)
Next
[o20].Resize(n, 9) = crr
End Sub

复制代码

dnvjfdeuff · 发表于 2024-5-22 09:05

全党发表于 2024-5-22 06:52

大神，就是无购入价时，取到了，最后一个价，在相减

		自动登录	找回密码
密码			免费注册

求助大神 ，求不同日期段平均价和购入平均价