求助：vba如何改成JS,如下

fjm2003 · 发表于 2024-9-29 10:04

Sub tqwd1() '打开文件
Dim f1
f1 = Application.GetOpenFilename(filefilter:= _
"excel(*.xls),*.xls")
If f1 <> False Then Workbooks.Open fileName:=f1 _
, ReadOnly:=False
End Sub

Qs18 · 发表于 2024-10-5 18:59

function ShowFileDialog() {
let dlgOpen = Application.FileDialog(msoFileDialogOpen);
dlgOpen.AllowMultiSelect = true;
dlgOpen.Show();
}

Qs18 · 发表于 2024-10-5 19:02

function ShowFileDialog() {
let dlgOpen = Application.FileDialog(msoFileDialogFilePicker);
dlgOpen.AllowMultiSelect = true; // 允许选择多个文件
dlgOpen.Title = "请选择文件"; // 对话框标题
dlgOpen.Show();
if (dlgOpen.SelectedItems.Count > 0) {
let selectedFiles = dlgOpen.SelectedItems;
for (let i = 1; i <= selectedFiles.Count; i++) {
console.log(selectedFiles(i)); // 在控制台输出选中的文件路径
}
} else {
console.log("没有选择任何文件。");
}
}

复制代码

CapitalChueh · 发表于 2024-10-6 15:57

受益匪浅~~~~~

fjm2003 · 发表于 2024-10-10 10:58

谢谢各位老师回贴

yangqianming · 发表于 2024-10-11 20:49

Qs18 发表于 2024-10-5 19:02

Sub test()
Dim r%, i%, m%
Dim arr, brr, zrr()
Dim gs$
Dim d As Object
Dim rqmin As Date
Dim rqmax As Date
Dim rq1 As Date
Const pcrs As Integer = 2
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
With Worksheets("统计陪餐费")
rq = .Range("bq1").Value
End With
With Worksheets("就餐人数表")
.AutoFilterMode = False
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a2:a" & r)
For i = 1 To UBound(arr)
If Format(arr(i, 1), "yyyymm") = Format(rq, "yyyymm") Then
d1(arr(i, 1)) = Empty
End If
Next
riqi = d1.keys
n = 2
For Each aa In d1.keys
d1(aa) = n
n = n + 3
If rqmin = #12:00:00 AM# Then
rqmin = aa
Else
If rqmin > aa Then
rqmin = aa
End If
End If
If rqmax = #12:00:00 AM# Then
rqmax = aa
Else
If rqmax < aa Then
rqmax = aa
End If
End If
Next
ls = 1 + d1.Count * 3 + 2
r = .Cells(.Rows.Count, 6).End(xlUp).Row
arr = .Range("f2:i" & r)
End With
For i = 1 To UBound(arr)
xm = Right(arr(i, 2), 2)
Select Case arr(i, 2)
Case "小工友", "大工友", "其它人员"
For rq1 = Application.Max(rqmin, arr(i, 3)) To Application.Min(rqmax, arr(i, 4))
If d1.exists(rq1) Then
n = d1(rq1)
If Not d.exists(xm) Then
Set d(xm) = CreateObject("scripting.dictionary")
End If
If Not d(xm).exists(arr(i, 1)) Then
ReDim brr(1 To ls)
brr(1) = arr(i, 1)
Else
brr = d(xm)(arr(i, 1))
End If
brr(n) = 3
brr(n + 1) = 5
If arr(i, 2) = "大工友" Or arr(i, 2) = "其它人员" Then
brr(n + 2) = 5
End If
d(xm)(arr(i, 1)) = brr
End If
rq0 = rq1
Next
Case "教师"
For rq = Application.Max(rqmin, arr(i, 3)) To Application.Min(rqmax, arr(i, 4))
If d1.exists(rq) Then
d2(arr(i, 1)) = Empty
Exit For
End If
Next
End Select
Next
If d2.Count <> 0 Then
Set d("教师") = CreateObject("scripting.dictionary")
js = d2.keys
m = 0
For i = 0 To UBound(riqi)
n = d1(riqi(i))
If i <> 0 Then
If riqi(i) <> riqi(i - 1) + 1 Then
m = m + pcrs '偏移
End If
End If
If m + 1 > UBound(riqi) Then
Exit For
End If
For q = 1 To pcrs '陪餐教师个数
If Not d("教师").exists(js(m + q - 1)) Then
ReDim brr(1 To ls)
brr(1) = js(m + q - 1)
Else
brr = d("教师")(js(m + q - 1))
End If
brr(n) = 3
brr(n + 1) = 5
brr(n + 2) = 5
d("教师")(js(m + q - 1)) = brr
Next
Next
End If
With Worksheets("统计陪餐费")
.UsedRange.Offset(2, 0).Clear
With .Range("a3")
.Value = "陪餐人员"
.Resize(3, 1).Merge
End With
n = 2
For Each aa In d1.keys
With .Cells(3, n)
.NumberFormatLocal = "m月d日"
.Value = aa
.Resize(1, 3).Merge
End With
With .Cells(4, n)
.NumberFormatLocal = "[$-zh-CN]aaaa;@"
.Value = aa
.Resize(1, 3).Merge
End With
.Cells(5, n).Resize(1, 3) = Array("旱", "中", "晚")
n = n + 3
Next
With .Cells(3, n)
.Value = "顿人次"
.Resize(3, 1).Merge
End With
n = n + 1
With .Cells(3, n)
.Value = "金额"
.Resize(3, 1).Merge
End With
With .Range("a3").Resize(3, ls)
.Interior.Color = 10441261
.Font.Color = 16777215
End With
r = 6
gs = Empty
For Each aa In Array("工友", "教师", "人员")
If d.exists(aa) Then
m = 0
ReDim crr(1 To d(aa).Count, 1 To ls)
For Each bb In d(aa).keys
brr = d(aa)(bb)
If aa = "工友" Or aa = "教师" Then
For j = 0 To UBound(riqi) - 1
n = j * 3 + 2
If riqi(j) <> riqi(j + 1) - 1 Then
brr(n + 2) = Empty
End If
Next
End If
m = m + 1
For j = 1 To UBound(brr)
crr(m, j) = brr(j)
Next
Next
.Cells(r, 1).Resize(UBound(crr), UBound(crr, 2)) = crr
.Cells(r, ls - 1).Resize(UBound(crr), 1).FormulaR1C1 = "=COUNT(RC2:RC[-1])"
.Cells(r, ls).Resize(UBound(crr), 1).FormulaR1C1 = "=SUM(RC2:RC[-2])"
.Cells(r + UBound(crr), 1) = IIf(aa <> "人员", aa & "小计", "其他人员")
.Cells(r + UBound(crr), 2).Resize(1, ls - 1).FormulaR1C1 = "=SUM(R" & r & "C:R[-1]C)"
gs = gs & "+R" & r + UBound(crr) & "C"
r = r + UBound(crr) + 1
End If
Next
.Cells(r, 1) = "总计"
.Cells(r, 2).Resize(1, ls - 1).FormulaR1C1 = "=" & Mid(gs, 2)
With .Range("a3").Resize(r - 2, ls)
.Borders.LineStyle = xlContinuous
With .Font
.Name = "微软雅黑"
.Size = 11
End With
End With
.Columns(1).Resize(, ls).AutoFit
With .UsedRange
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End With
Application.ScreenUpdating = True
MsgBox "数据统计完毕！"
End Sub

复制代码

小学后勤陪餐费及收入统计表.rar (47.81 KB, 下载次数: 5)
这代码能改吗？

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