按年度分月份统计每个客户的应收款

LIUZHU · 发表于 2024-5-16 18:01

JSA代码，供参考

function 筛选统计(){
let year=InputBox("请输入统计年份：");
if (year.search(/\d{4}/)==-1) return;
let arr=Sheets.Item("客户").Range("a1").CurrentRegion.Value2.slice(1);
let wf=WorksheetFunction;
let obj=arr.reduce((obj,x)=>{
if (wf.Text(x[1],"yyyy")!=year) return obj;
let temp=obj[x[3]]=obj[x[3]] || [x[3],...Array(12),"=SUM(RC[-12]:RC[-1])"];
let n=wf.Text(x[1],"m");
temp[n]=(temp[n] || 0) + (x[10] || 0);
return obj;
},{});
let res=Object.values(obj);
if (res.length==0) return;
let app=Application;
[app.DisplayAlerts,app.ScreenUpdating]=[false,false];
Sheets.Item("统计表模版").Copy(null,Sheets.Item("客户"));
try{Sheets.Item("统计表").Delete()}catch{};
ActiveSheet.Name="统计表";
if (res.length>2) Range("a4").Resize(res.length-2,1).EntireRow.Insert();
Range("a3").Resize(res.length,res[0].length).FormulaR1C1=res;
[app.DisplayAlerts,app.ScreenUpdating]=[true,true];
}

复制代码

LIUZHU · 发表于 2024-5-16 18:01

附件，请用WPS软件测试

wang-way · 发表于 2024-5-16 19:43

JS凑个热闹

//wang-way 20240516
function transformData(){
var wb=ThisWorkbook;
var sht=wb.Worksheets.Item('客户');
var ar=sht.Range('a1').CurrentRegion.Value();
//月份去重
dc=new Set(ar.slice(1).map(x=>new Date(x[1]).getMonth()+1+'月'));
//客户去重
dr=new Set(ar.slice(1).map(x=>x[3]));
//最终输出数组
br=[];
//添加行头
br.push(['',...Array.from(dc),'合计'])
//先逐行循环，再逐列循环
dr.forEach(x=>{
//每一行数据的构建
r=[];
//添加客户到首列
r.push(x);
rsum=0;
dc.forEach(y=>{
//Debug.Print('客户:',x,'月份:',y);
//筛选指定客户指定月份的数据
tmp=ar.filter(r=>r[3]==x && new Date(r[1]).getMonth()+1+'月'==y);
//Debug.Print(tmp.length);
//如有满足数据
if(tmp.length>0){
//提取金额列数据
act=tmp.map(a=>a[10])
//行合计
mysum=act.reduce((a,c)=>Number(a)+Number(c));
//Debug.Print('客户:',x,'月份:',y,'金额',mysum)
r.push(mysum);
rsum=rsum+mysum;
}
else{
//客户当月没有数据
r.push('')
}
})
r.push(rsum);
br.push(r);
})
//列合计
r=[];
r.push('合计');
//逐列求和
for(let j=1;j<br[1].length;j++){
mysum=br.slice(1).map(x=>x[j]).reduce((a,c)=>Number(a)+Number(c));
Debug.Print(j+1,mysum);
r.push(mysum);
}
br.push(r);
//Output
sht=wb.Worksheets.Item('统计表');
sht.UsedRange.Offset(1,0).Clear();
sht.Range('a2').Resize(br.length,br[0].length).Value2=br;
}

复制代码

ykcbf1100 · 发表于 2024-5-17 08:03

本帖最后由 ykcbf1100 于 2024-5-17 08:05 编辑

参与一下，全表自动生成。

ykcbf1100 · 发表于 2024-5-17 08:04

参与一下。。。

Sub ykcbf() '//2024.5.17
Dim arr, brr, d
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set d = CreateObject("scripting.dictionary")
rq = Date
nf = Application.InputBox("请输入查询年份：", "年份", Year(rq))
With Sheets("客户")
r = .Cells(Rows.Count, 1).End(3).Row
arr = .Range("a1").Resize(r, 12)
End With
ReDim brr(1 To UBound(arr), 1 To 100)
brr(1, 1) = nf & "年应收款分客户分月份统计表"
brr(2, 1) = arr(1, 4)
m = 2: n = 1
For i = 2 To UBound(arr)
If Year(arr(i, 2)) = Val(nf) Then
s = arr(i, 4)
If Not d.exists(s) Then
m = m + 1
d(s) = m
brr(m, 1) = s
End If
r = d(arr(i, 4))
s = Month(arr(i, 2)) & "月"
If Not d.exists(s) Then
n = n + 1
d(s) = n
brr(2, n) = s
End If
c = d(Month(arr(i, 2)) & "月")
brr(r, c) = brr(r, c) + arr(i, 11)
End If
Next
With Sheets("统计表")
.UsedRange.Clear
.[a1].Resize(1, n + 1).Merge
.[a1].Resize(2, n + 1).Interior.Color = 49407
.[a3].Resize(m - 1, 1).Interior.Color = 5296274
With .[a1].Resize(m + 1, n + 1)
.Value = brr
.Borders.LineStyle = 1
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
With .Font
.Name = "微软雅黑"
.Size = 11
End With
End With
.Cells(2, n + 1) = "合计"
For i = 3 To m + 1
.Cells(i, n + 1) = Application.WorksheetFunction.Sum(.Cells(i, 2).Resize(1, n - 1))
Next
m = m + 1
.Cells(m, "a") = "合计"
.Cells(m, "b").Resize(1, n).FormulaR1C1 = "=SUM(R3C:R" & "[-1]C)"
End With
Set d = Nothing
MsgBox "OK！"
End Sub

复制代码

LIUZHU · 发表于 2024-5-21 22:45

wang-way 发表于 2024-5-16 19:43
JS凑个热闹

有时候可以利用工作表函数求和，没必要非得在代码中把合计求出来

wang-way · 发表于 2024-5-21 22:51

LIUZHU 发表于 2024-5-21 22:45
有时候可以利用工作表函数求和，没必要非得在代码中把合计求出来

是的仔细看了你的代码最后一列是插入公式求和了。谢谢您的宝贵经验

LIUZHU · 发表于 2024-5-21 23:44

wang-way 发表于 2024-5-21 22:51
是的仔细看了你的代码最后一列是插入公式求和了。谢谢您的宝贵经验

而且R1C1样式的公式，在代码中用处极大，可以充分利用JSA的模版字符串的功能。

wengjl · 发表于 2024-5-22 16:11

Sub 应收款统计()
' https://club.excelhome.net/threa ... tml?_dsign=d49726a9
' 2024-5-22 星期三
Sheet1.Select
Rows("3:1000").Delete Shift:=xlUp    ' 删除前一次的统计结果
x2 = 2
Do While Not (IsEmpty(Sheet2.Cells(x2, 2).Value))
   kh = Sheet2.Cells(x2, 4).Value
   foun = False
   x1 = 3
   Do While Not (IsEmpty(Sheet1.Cells(x1, 1).Value))
      If Sheet1.Cells(x1, 1).Value = kh Then
      foun = True
      Exit Do
      End If
      x1 = x1 + 1
   Loop
   If foun = False Then
      Sheet1.Cells(x1, 1).Value = kh
   End If
   x2 = x2 + 1
Loop
'---客户信息提取完成
nf = InputBox("请输入想要统计的年号：" + Chr(13) + Chr(13) + "如 “2024”", "Microsoft Excel输入对话：", "2024")
Sheet1.Cells(1, 1).Value = nf & "年应收款分客户分月份统计表" ' 根据统计年份的设定，修改统计表头名称
For y = 1 To 12
   x1 = 3
   Do While Not (IsEmpty(Sheet1.Cells(x1, 1).Value))
      kh = Sheet1.Cells(x1, 1).Value
      sn = 0
      x2 = 2
      Do While Not (IsEmpty(Sheet2.Cells(x2, 2).Value))
      If Sheet2.Cells(x2, 4).Value = kh And Month(Sheet2.Cells(x2, 2).Value) = y And Year(Sheet2.Cells(x2, 2).Value) = Val(nf) Then
            sn = sn + Sheet2.Cells(x2, 11).Value ' 符合年份、月份、客户的应收款累计
      End If
      x2 = x2 + 1
      Loop
      Sheet1.Cells(x1, y + 1).Value = sn
      x1 = x1 + 1
   Loop
Next y
'---统计完成
Sheet1.Cells(x1, 1).Value = "合计"
For y = 1 To 12
   sn = 0
   For x = 3 To x1 - 1
      sn = sn + Cells(x, y + 1)
   Next x
   Cells(x, y + 1) = sn ' 纵向求和
Next y
For x = 3 To x1
   sn = 0
   For y = 1 To 12
      sn = sn + Cells(x, y + 1)
   Next y
   Cells(x, y + 1) = sn ' 横向求和
Next x
End Sub

jaxpqh · 发表于 2024-5-25 23:25

chxw68 发表于 2024-5-16 12:04
参与一下。

　　大师，您好！我根据您的VBA代码，设计了应付款统计表，但有些数据统计不到，请您帮我看看是什么原因，我只改了对应的列的代码，其他代码我并没有改动，按理应该没问题的，可就是只能统计部分数据。先谢谢您了！

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

[求助] 按年度分月份统计每个客户的应收款

评分

评分

评分

评分