求助大佬！帮忙把VBA代码转成WPS JS宏代码

chenqiuxin09

原先代码如下:
Sub 批量导入多个工作簿的表到一个工作簿里()
Dim currWorkbook As Workbook
Dim shtCurr, shtLast As Worksheet
Dim strFilter, strTmpSheetName As String
Dim isHuiZong As Boolean
Dim vbMsgResult As VbMsgBoxResult

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set currWorkbook = ActiveWorkbook
Set shtCurr = ActiveSheet
Set shtLast = shtCurr
isHuiZong = False

strFilter = "Excel Files(*.xl*)，*.x1*"
selectWorkbooks = Application.GetOpenFilename(strFilter, Title:="请选择要合并工作簿：", MultiSelect:=True)
On Error Resume Next
vbMsgResult = MsgBox("导入到工作簿点击‘是’，汇总到一个表里点击‘否’ ? ", vbExclamation + vbYesNoCancel)
Select Case vbMsgResult
Case vbNo
   isHuiZong = True
Case vbCancel
   Exit Sub
End Select
  For Each eachWorkbook In selectWorkbooks
      If eachWorkbook <> False Then
          Set OpenBook = Workbooks.Open(eachWorkbook)
          For Each xiSheet In OpenBook.Sheets
              strTmpSheetName = OpenBook.Name & "_" & xiSheet.Name
       For Each tmpSheet In currWorkbook.Sheets
           If tmpSheet.Name = strTmpSheetName Then
              tmpSheet.Delete
              Exit For
           End If
        Next
        xiSheet.Copy After:=shtLast
        currWorkbook.Sheets(xlSheet.Name).Name = strTmpSheetName
     Next
     OpenBook.Close SaveChanges:=False
     Set shtLast = currWorkbook.Sheets(strTmpSheetName)
End If
Next

shtCurr.Select

If isHuiZong = False Then
    MsgBox "导入到工作簿成功！", vbExclamation
Else
    汇总多表到一个表
    For Each tmpSheet In currWorkbook.Sheets
        If tmpSheet.Name <> shtCurr.Name Then
             tmpSheet.Delete
        End If
    Next
End If

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Sub 汇总多表到一个表()
    Dim shtHui As Worksheet
    Dim maxRow, maxRow_1 As Long
    Dim strExName As String

    Set shtHui = ActiveSheet
    maxRow = shtHui.Cells(Rows.Count, "A").End(xlUp).Row
    If maxRow > 1 Then shtHui.Rows("2:" & maxRow).ClearContents
    For Each sht In Sheets
        strExName = sht.Name
        If strExName <> shtHui.Name Then
            maxRow_1 = sht.Cells(Rows.Count, "A").End(xlUp).Row
            sht.Select
            sht.Rows("2:" & maxRow_1).Select
            Selection.Copy
            maxRow = shtHui.Cells(Rows.Count, "A").End(xlUp).Row
            shtHui.Select
            Cells(maxRow + 1, "A").Select
            Selection.PasteSpecial Paste:=xPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False


        End If
    Next
    shtHui.Select
    Cells(2, "B").Select
    MsgBox "汇总到表里成功! ", vbExclamation
End Sub

Again123456

汇总.7z (5.88 KB, 下载次数: 8)

2024-2-5 09:41 上传

点击文件名下载附件

第一个给你改了一下，第二个自己可以在业务代码里改

chenqiuxin09

Again123456 发表于 2024-2-5 08:43
https://club.excelhome.net/thread-1668477-1-1.html?_dsign=88246f33  做一个类似的题目，这段VBA代码打 ...

昨晚有看到这个主题，那段是对表头有校验，我这段没有，单纯是将选择的文件进行汇总或拆分

Again123456

不重新了，复制一个来改了一下：

1. function collectSheetFromBook(){
   
2.     Application.ScreenUpdating = false
   
3.     Application.DisplayAlerts = false
   
4.     let th = ThisWorkbook
   
5.     let fd = Application.FileDialog(msoFileDialogFilePicker)
   
6.     fd.Title="请选择要汇总的文件"
   
7.     fd.InitialFileName = th.Path
   
8.     fd.AllowMultiSelect = true;
   
9.     fd.Filters.Add("Execel文件","*.xls*,*.et")
   
10.     fd.FilterIndex = fd.Filters.Count
    
11.     fd.Show();
    
12.     let arr = [...fd.SelectedItems]  
    
13.     fd.Filters.Delete(fd.Filters.Count)  
    
14.     if (!fd.SelectedItems) return //是否选择验证
    
15.     arr.forEach(filename => {
    
16.         let wb,shts
    
17.         let myname = /.+\\(.+\.\w+)/.exec(filename)[1]//工作簿名，用于是否打开验证
    
18.         if (filename != th.FullName) {//验证是否选择了汇总工作簿本身
    
19.             let openFile=[...Workbooks].map(v => v.Name)
    
20.             if(openFile.includes(myname)){//是否打开验证
    
21.                 wb = Workbooks(myname)
    
22.                 shts = [...wb.Worksheets]
    
23.                 shts.forEach(sht => {
    
24.                         //业务代码
    
25.                         let shName = wb.Name.split(".")[0] + "_" +sht.Name
    
26.                         th.Activate()
    
27.                         try {th.Sheets(shName).Delete()} catch{}
    
28.                     let sh= th.Sheets.Add({After:th.Sheets(Sheets.Count)})
    
29.                     sh.Name = shName
    
30.                     sht.UsedRange.Copy(sh.Range("A1"))
    
31.                     sh.UsedRange.Columns.AutoFit()
    
32.                 })
    
33.             }else{
    
34.                 wb = Workbooks.Open({Filename:filename,Password:"321"})
    
35.                 shts = [...wb.Worksheets]
    
36.                 shts.forEach(sht => {
    
37.                         //业务代码
    
38.                     let shName = wb.Name.split(".")[0] + "_" +sht.Name
    
39.                         th.Activate()
    
40.                         try {th.Sheets(shName).Delete()} catch{}
    
41.                     let sh= th.Sheets.Add({After:th.Sheets(Sheets.Count)})
    
42.                     sh.Name = shName
    
43.                     sht.UsedRange.Copy(sh.Range("A1"))
    
44.                     sh.UsedRange.Columns.AutoFit()
    
45.                   
    
46.                 })
    
47.                  wb.Close(false)
    
48.             }        
    
49.         }            
    
50.             
    
51.     })
    
52.     Application.DisplayAlerts = true  
    
53.     Application.ScreenUpdating = true
    
54. }
    

复制代码

chenqiuxin09

Again123456 发表于 2024-2-5 09:38
不重新了，复制一个来改了一下：

我改写了let th = ActiveWorkbook，还缺少汇总选项

cjc209

wps js 多表合并 这样就可以了
var arr=[...Sheets].flatMap(sht=>sht.Range("a1").CurrentRegion.Value2.slice(2))

slice(2)这个是跳过表头行数 就是一句代码的事情 前提表的格式 字段不能乱

cjc209

比vba 简单多了

Again123456

chenqiuxin09 发表于 2024-2-5 13:48
我改写了let th = ActiveWorkbook，还缺少汇总选项

应该不是这个原因，你是改了其他地方，或者你选择汇总是文件只有一个，且是ActiveWorkbook本身