如何双条件筛选excel数据生成csv

dickmartin

各位大神看一下我这个东西，基础数据能用到的有5列，A列是日期，B列是公司名，CDE列是指标，我想生成若干文件夹，文件夹名为各公司名，每个文件夹下按照日期生成CSV文件，一般来说是每个月所有日期都有数据，但也有例外。我这个是2月的，每个公司能生成29个CSV。每个CSV里是该公司当日的CDE列数据，不需要表头。这个样表里只有5个公司，实际上有几十个，每月要手动生成几百张表，太费劲了，不知道哪位大神能帮帮忙！

ykcbf1100

3级字典，文件夹自动生成

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.4.10
   
2.     Dim arr, d
   
3.     Set fso = CreateObject("Scripting.FileSystemObject")
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     Dim tm: tm = Timer
   
7.     Set d = CreateObject("Scripting.Dictionary")
   
8.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
9.     p = ThisWorkbook.Path & ""
   
10.     With Sheets("Sheet1")
    
11.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
    
12.         arr = .[a1].Resize(r, 5)
    
13.     End With
    
14.     For i = 2 To UBound(arr)
    
15.         s = arr(i, 2): ss = CStr(arr(i, 1))
    
16.         If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
    
17.         If Not d(s).exists(ss) Then Set d(s)(ss) = CreateObject("Scripting.Dictionary")
    
18.         d(s)(ss)(i) = i
    
19.     Next
    
20.     For Each k In d.keys
    
21.         p1 = p & k & ""
    
22.         If Not fso.FolderExists(p1) Then fso.CreateFolder p1
    
23.         For Each kk In d(k).keys
    
24.             Application.SheetsInNewWorkbook = 1
    
25.             Set wb = Workbooks.Add
    
26.             m = 0
    
27.             ReDim brr(1 To UBound(arr), 1 To 3)
    
28.             With wb.Sheets(1)
    
29.                 .Name = kk
    
30.                 For Each kkk In d(k)(kk).keys
    
31.                     m = m + 1
    
32.                     For j = 3 To UBound(arr, 2)
    
33.                         brr(m, j - 2) = arr(kkk, j)
    
34.                     Next
    
35.                 Next
    
36.                 .[a1].Resize(m, 3) = brr
    
37.             End With
    
38.             wb.SaveAs p1 & kk,6
    
39.             wb.Close
    
40.         Next
    
41.     Next
    
42.     Set d = Nothing
    
43.     Application.ScreenUpdating = True
    
44.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
45. End Sub
    

复制代码

dickmartin

太感谢了，我写了一大堆运行半天也出不来，您这个很快就生成了，感谢大神

LIUZHU

这个效果，如图所示

LIUZHU

JSA代码，请参考

1. function 生成CSV(){
   
2.         let arr=Range("a1").CurrentRegion.Value2.slice(1);
   
3.         let obj=arr.reduce((dic,x)=>{
   
4.                 let key=x[1] + "_" + x[0];
   
5.                 return ((dic[key]=dic[key] || []).push(x),dic);
   
6.         },{});
   
7.         for (let key in obj){
   
8.                 let [dw,rq]=key.split("_");
   
9.                 let path=`${ThisWorkbook.Path}\\${dw}`;
   
10.                 if (Dir(path,16)=="") MkDir(path);                //创建文件夹
    
11.                 let fname=`${path}\\${key}.csv`;
    
12.                 if (Dir(fname,8)!="") Kill(fname);
    
13.                 Open(fname,"#1",jsBinary,jsWrite);                        //写入没有双引号
    
14.                 obj[key].forEach(x=>Put("#1",`${x.join(",")}\n`));
    
15.                 Close("#1");
    
16.         }
    
17.         alert(`<h1 style="color:red;">生成完毕。</h1>`);
    
18. }

复制代码

LIUZHU

需要WPS打开测试，运行JS宏