从”数据”工作薄中将所有单位的各编码的值提取到本表中，并在E列计算。要求用VBA...

lizequn1976 · 发表于 2024-10-10 15:42

从”数据”工作薄中将所有单位的各编码的值提取到本表中，并在E列计算。要求用VBA实现。

ykcbf1100 · 发表于 2024-10-10 16:02

附件供参考。。。

ykcbf1100 · 发表于 2024-10-10 16:03

参与一下。。。

只是、那个人 · 发表于 2024-10-10 16:06

看不懂需求，是只提取对应B1C1D1 的单位编号的值进行计算？

autohotey · 发表于 2024-10-10 16:23

本帖最后由 autohotey 于 2024-10-10 16:40 编辑

需要把数据表打开后运行

Sub test()
Dim awb As Workbook
Set awb = Workbooks("test.xlsm")
Dim asheet As Worksheet
Set asheet = awb.Sheets("Sheet1")
Dim bwb As Workbook
Set bwb = Workbooks("数据.xlsx")
Dim bsheet As Worksheet
Set bsheet = bwb.Sheets("Sheet1")
Dim lastRowA As Long
lastRowA = asheet.Cells(asheet.Rows.Count, "A").End(xlUp).Row
Dim lastRowB As Long
lastRowB = bsheet.Cells(bsheet.Rows.Count, "A").End(xlUp).Row
Dim i As Long, j As Long
Dim aid As Variant
Dim a
For i = 2 To lastRowA
aid = Array(asheet.Cells(i, "A").value & asheet.Cells(1, "B").value, _
asheet.Cells(i, "A").value & asheet.Cells(1, "C").value, _
asheet.Cells(i, "A").value & asheet.Cells(1, "D").value)
For Each a In aid
For j = 2 To lastRowB
Dim bid As String
bid = bsheet.Cells(j, "A").value & bsheet.Cells(j, "B").value
If a = bid Then
Select Case ArrayIndex(a, aid)
Case 0
asheet.Cells(i, "B").value = bsheet.Cells(j, "C").value
Case 1
asheet.Cells(i, "C").value = bsheet.Cells(j, "C").value
Case 2
asheet.Cells(i, "D").value = bsheet.Cells(j, "C").value
End Select
Exit For
End If
Next j
Next a
If IsEmpty(asheet.Cells(i, "B").value) And IsEmpty(asheet.Cells(i, "C").value) And IsEmpty(asheet.Cells(i, "D").value) Then
asheet.Cells(i, "E").value = ""
Else
asheet.Cells(i, "E").value = asheet.Cells(i, "B").value + asheet.Cells(i, "C").value - asheet.Cells(i, "D").value
End If
Next i
End Sub
Function ArrayIndex(value As Variant, arr As Variant) As Long
Dim i As Long
For i = LBound(arr) To UBound(arr)
If arr(i) = value Then
ArrayIndex = i
Exit Function
End If
Next i
ArrayIndex = -1
End Function

复制代码

lcluck2002 · 发表于 2024-10-10 16:33

比较基础的字典的用法。供仅参考。。。。。。

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

[求助] 从”数据”工作薄中将所有单位的各编码的值提取到本表中，并在E列计算。要求用VBA...

评分