|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub tianchong()
With Sheets("人员")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "人员为空!": End
ar = .Range("a1:f" & r)
End With
With Sheets("工资")
rs = .Cells(Rows.Count, 1).End(xlUp).Row
If rs < 2 Then MsgBox "工资为空!": End
br = .Range("a1:h" & rs)
End With
ReDim arr(1 To UBound(br), 1 To 9)
With Sheets("模板")
xh = .[m1]
If xh > r Then MsgBox "往下没有了!": End
.Range("a7:j18") = Empty
rr = Array(.[b2].Address, .[b3].Address, .[h2].Address, .[e3].Address, .[g3].Address, .[j3].Address)
For i = 0 To UBound(rr)
dz = rr(i)
.Range(dz) = ar(xh, i + 1)
Next i
For i = 2 To UBound(br)
If Trim(br(i, 1)) = Trim(ar(xh, 1)) Then
n = n + 1
arr(n, 1) = br(i, 3)
arr(n, 3) = br(i, 4)
arr(n, 5) = br(i, 5)
arr(n, 6) = br(i, 6)
arr(n, 7) = br(i, 7)
arr(n, 9) = br(i, 8)
End If
Next i
If n <> "" Then
.[a7].Resize(n, 9) = arr
End If
End With
End Sub
|
|