来求助也不传个附件
虽然这个题目跟本版块没有关系,还是帮你解决掉吧——
- Option Explicit
- Sub 自动分配数值()
- Dim i%, j%, arr
- Dim ASum As Long, BSum As Long
- Application.ScreenUpdating = False '关闭屏幕刷新
- With ThisWorkbook.Sheets(1)
- For i = 2 To .[A1].End(xlDown).Row '从第2行开始循环
- '把某机种第一行数值赋值给数组arr
- If Len(.Cells(i, 4)) > 0 Then arr = .Range("A" & i & ":K" & i)
- For j = 4 To 11 '从第4列(D)到第11列(K)进行循环
- If .Cells(i, 1) = arr(1, 1) Then '判断是否同一机种
- '统计横向累计数
- ASum = Application.Sum(Range(.Cells(i, 4), .Cells(i, j - 1)))
- '统计纵向累计数
- BSum = Application.SumIf(Range(.Cells(1, 1), .Cells(i - 1, 1)), arr(1, 1), Range(.Cells(1, j), .Cells(i - 1, j)))
- If BSum = arr(1, j) Then
- .Cells(i, j) = "" '纵向累计已满时置空
- Else
- '横纵向累计未满时取差值
- .Cells(i, j) = Application.Min(arr(1, j) - BSum, .Cells(i, 3) - ASum)
- .Cells(i, j) = IIf(.Cells(i, j) = 0, "", .Cells(i, j)) '0值置空
- End If
- End If
- Next j
- Next i
- End With
- Application.ScreenUpdating = True '打开屏幕刷新
- End Sub
复制代码 |