|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Option Explicit
Private Sub 一键点击将对应备注填入目标单元格_Click()
Dim arr, i, j, dic, t, m
Set dic = CreateObject("scripting.dictionary")
arr = Range("i3:n" & Cells(Rows.Count, "i").End(xlUp).Row)
For i = 1 To UBound(arr, 1)
t = arr(i, 1): m = m + 1
For j = 2 To UBound(arr, 2) - 1
t = t & arr(i, j): arr(m, j) = arr(i, j)
Next
If Not dic.exists(t) Then
dic(t) = arr(i, j): arr(m, j) = arr(i, j)
Else
m = m - 1
End If
Next
With [i3]
.Resize(Rows.Count - 2, UBound(arr, 2)).ClearContents
.Resize(m, UBound(arr, 2)) = arr
End With
arr = Range("b3:f" & Cells(Rows.Count, "b").End(xlUp).Row)
For i = 1 To UBound(arr, 1)
t = arr(i, 1)
For j = 2 To UBound(arr, 2): t = t & arr(i, j): Next
arr(i, 1) = IIf(dic.exists(t), dic(t), "无对应数据")
Next
[g3].Resize(UBound(arr, 1)) = arr
End Sub |
评分
-
1
查看全部评分
-
|