EXCEL VBA这些语句是什么意思,有大神逐句翻译吗?
发布网友
发布时间:2022-05-10 21:14
我来回答
共4个回答
热心网友
时间:2023-11-01 07:38
Private Sub Worksheet_Activate() '工作表激活事件
Set d = CreateObject("Scripting.Dictionary") '赋值D为字典对象
arr = Sheet1.UsedRange
For i = 2 To UBound(arr)
If arr(i, 1) <> "" Then d(arr(i, 1)) = "" 'D增加关键字
Next
With Range("B2").Validation
.Delete
.Add 3, 1, 1, Join(d.keys, ",") 'B2增加数据有效性等于D关键字相连的值
End With
Set d = Nothing
End Sub
Sub 查询()
Dim d, arr, brr(), ar, br(), abr(), m, n, i, j, a, b, aa, s
Range("A5:P10000").ClearContents '清除("A5:P10000")单元格区域内容
If Range("B2") = "" Then MsgBox "请选择【料号】!程序退出。", 64, "温馨提示": Exit Sub
If Range("C2") = "" Then MsgBox "请填写出库数量!程序退出。", 64, "温馨提示": Exit Sub '单元格B2和C2单元格为空值时弹出对话框提示
arr = Sheet1.UsedRange '赋值ARR
For i = 2 To UBound(arr) '在ARR1维中循环
If arr(i, 1) = Range("B2") And arr(i, 4) = "Available" Then '判定单元格是否等于 Range("B2") 和arr(i, 4) = "Available"就执行下面的代码
m = m + 1 'M值进行累加
ReDim Preserve brr(1 To 7, 1 To m) '给BRR数给赋值,
For j = 1 To 6 'J从一到6循环
brr(j, m) = arr(i, j) '给BRR赋值等于对应的arr数组理面的值
Next
brr(7, m) = arr(i, 10) '同样是是BRR赋值
End If
If arr(i, 1) = Range("B2") Then '判定arr(i, 1) = Range("B2")就执行下面代码
s = s + 1 'S值进行累加
ReDim Preserve abr(1 To 7, 1 To s) 'M 同样也是给abr赋值等于对应的arr数组理面的值
For j = 1 To 6
abr(j, s) = arr(i, j)
Next
abr(7, s) = arr(i, 10)
End If
Next
If m = 0 Then '判断M等于0就执行下面的程序
Range("B5:H10000").ClearContents '清除(("B5:H10000")单元格区域内容
[B5].Resize(s, 7) = Application.Transpose(abr) '{B5]扩充区域后赋值等于abr转置的值
Range("B5:H" & s + 4).Sort [H5] '对H列排序
MsgBox "【" & Range("B2") & "】料号可出库的库存是【0】!程序退出。", 64, "温馨提示" '弹出提示
Exit Sub '退出程序
End If
[B5].Resize(m, 7) = Application.Transpose(brr) ' '{B5]扩充区域后赋值等于BRR转置的值
Range("B5:H" & m + 4).Sort [H5] '对H列排序
arr = Range("B5:H" & m + 4) '重新赋值ARR
Range("B5:H10000").ClearContents '清除(("B5:H10000")单元格区域内容
[B5].Resize(s, 7) = Application.Transpose(abr) ' '{B5]扩充区域后赋值等于abr转置的值
Range("B5:H" & s + 4).Sort [H5] '对H列排序
For i = 1 To UBound(arr) '在ARR数组中循环
a = a + arr(i, 3) '给A赋值
Next
b = Val(Range("C2")) '给B赋值
If a - b < 0 Then '判定A-B小于0就执行下面程序
MsgBox "【" & Range("B2") & "】料号现有库存 " & a & " 不够本次出库!程序退出。", 64, "温馨提示" '弹出提示
Exit Sub
End If
For i = 1 To UBound(arr)
n = n + 1
ReDim Preserve br(1 To 7, 1 To n)
For j = 1 To 7
br(j, n) = arr(i, j)
Next
aa = aa + arr(i, 3)
If Val(aa) >= Val(b) Then
Exit For
End If
Next
br(3, n) = br(3, n) - (aa - b)
[J5].Resize(n, 7) = Application.Transpose(br) '上述代码就是给[J5].Resize(n, 7)这个区域赋值等于转置后的(br) 内容
End Sub
热心网友
时间:2023-11-01 07:38
这么多,逐句解释,有点强人所难呀,并且一点奖励都没有。
热心网友
时间:2023-11-01 07:39
原文件看看,PMC的同行,你要改啥》sosomc@163.com
ReDim Preserve brr(1 To 7, 1 To m)这句应该会报错
热心网友
时间:2023-11-01 07:39
字典
数组