apang

也来一个：

@set @n=0;/* & echo off
set "cell=D37 D38 D39"
for %%a in (*.csv) do (
        cscript -nologo -e:jscript "%~0"<"%%a">>$ "%cell%"
)
move $ new.csv
pause & exit & */

arg = WScript.Arguments(0).split(" ");
txt = WScript.StdIn.ReadAll();
arTxt = txt.replace(/(\s*\n)+$/, "").split("\r\n");
chr = "0ABCDEFGHIJKLMNOPQRSTUVWXYZ";
arCell = [];
for (i=0; i<arg.length; i++) {
        m = arg[i].match(/\d+$/)[0] - 1;
        n = ("0" + arg[i]).match(/(..)\d+$/)[1].toUpperCase();
        n1 = chr.indexOf(n.substr(0, 1));
        n2 = chr.indexOf(n.substr(1));
        n = n1 * 26 + n2 - 1;
        arCell.push(arTxt[m].split(",")[n]);
}
WScript.Echo(arCell.join(","))
复制代码

apang

再来一下：

arrCell = Array("D37", "D38", "D39") ''需要提取的单元格
Set fso = CreateObject("Scripting.FileSystemObject")
For Each file in fso.GetFolder(".").Files
        If LCase(Right(file, 4)) = ".csv" Then
                Set f = fso.OpenTextFile(file, 1)
                txt = f.ReadAll : f.Close
                str = str & getCellsData(txt) & vbCrLf
        End If
Next

fso.OpenTextFile("new.csv", 2, true).Write str
MsgBox "OK"

Function getCellsData(ByVal txt)
        '' csv文本分割成数组
        arrTxt = Split(txt, vbCrLf)
        strChr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
        ''建立正则表达式
        Set re = New RegExp
        ''正则表达式模式，最大支持到ZZ列
        re.Pattern = "^([a-z]{1,2})(\d+)$"
        re.IgnoreCase = true
        For i = 0 to UBound(arrCell)
                n = re.Execute(arrCell(i))(0).SubMatches(0)
                n = UCase(Right("0" & n, 2))
                n1 = InStr(strChr, Left(n, 1))
                n2 = InStr(strChr, Mid(n, 2))
                n = n1 * 26 + n2 - 1
                m = re.Execute(arrCell(i))(0).SubMatches(1) - 1
                s = s & "," & Split(arrTxt(m), ",")(n)
        Next
        getCellsData = Mid(s, 2)
End Function
复制代码

apang

除非单个文件几百兆上G级，否则不可能“刷一个要50分钟”。
如此，你应该在顶楼就交代清楚
顶楼不说清楚，一会想实现这样一会又想那样，什么心态？“我是小白”很了不起吗？
给你代码不会用，活该你慢。

apang

回复 49# haichuan5121


    代码没有做容错处理，如果输入的行数或列数大于csv文件本身的行数或列数，就会报“下标越界”

解决办法：在vbs代码开头插入一行：

On Error Resume Next
复制代码