|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
不会吧,我这里运行出结果了
- Sub kdy()
- arr = Sheet2.Range("a1:o" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row)
- brr = Sheet1.Range("a1:k" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)
- If Day(Now) <= 15 Then
- For i = 1 To UBound(arr, 2)
- If Format(Month(Now) - 1, "00月") = arr(1, i) Then
- For j = 1 To UBound(arr)
- For k = 2 To UBound(brr)
- If arr(j, 2) = brr(k, 3) And brr(k, 11) <> "" Then
- arr(j, i) = brr(k, 11)
- ElseIf arr(j, 2) = brr(k, 3) And brr(k, 11) = "" Then
- arr(j, i) = brr(k, 8) - brr(k, 9)
- End If
- Next
- Next
- End If
- Next
- Else
- For i = 1 To UBound(arr, 2)
- If Format(Month(Now), "00月") = arr(1, i) Then
- For j = 1 To UBound(arr)
- For k = 2 To UBound(brr)
- If arr(j, 2) = brr(k, 3) And brr(k, 11) <> "" Then
- arr(j, i) = brr(k, 11)
- ElseIf arr(j, 2) = brr(k, 3) And brr(k, 11) = "" Then
- arr(j, i) = brr(k, 8) - brr(k, 9)
- End If
- Next
- Next
- End If
- Next
- End If
- Sheet2.Range("a1:o" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row) = arr
- End Sub
复制代码
|
|