求助

shenjianrong163

孙惠彪 发表于 2020-5-29 14:12
老师，这就是我想要的结果。

原数据呢？你开始发的数据不全。

孙惠彪

shenjianrong163 发表于 2020-5-29 14:22
原数据呢？你开始发的数据不全。

老师，数据就是这样的，原本的H,J,K,L,M这几列的单元格是分开的都没有数据，并不是合并到一块的。我想要的就是同一姓名不管几行H,J,K,L,M列都根据行数合并单元格，然后填充公式。

shenjianrong163

孙惠彪 发表于 2020-5-29 14:38
老师，数据就是这样的，原本的H,J,K,L,M这几列的单元格是分开的都没有数据，并不是合并到一块的。我想要 ...

“工时费”怎样来的？

孙惠彪

shenjianrong163 发表于 2020-5-29 14:43
“工时费”怎样来的？

合并单元格后手动输入

一把小刀闯天下

'看不太懂，先给你凑一个，，，

Option Explicit

Sub test()
  Dim arr, i, j, p, sum, pos
  arr = [a1].CurrentRegion.Offset(1).Resize(, 13).Value
  ReDim brr(1 To UBound(arr, 1) * 2, 1 To UBound(arr, 2)), sum(UBound(arr, 2))
  pos = Array(8, 10, 11, 12, 13)
  For i = 1 To UBound(arr, 1) - 1
    sum(pos(0)) = sum(pos(0)) + arr(i, 6) * arr(i, 7)
    sum(pos(1)) = sum(pos(1)) + arr(i, 6) * arr(i, 9)
    For j = 2 To UBound(pos) - 1
      sum(pos(j)) = sum(pos(j)) + arr(i, pos(j))
    Next
    If arr(i, 1) <> arr(i + 1, 1) Then
      For j = 0 To UBound(pos) - 1
        arr(p + 1, pos(j)) = sum(pos(j)): sum(pos(j)) = 0
      Next
      arr(p + 1, pos(j)) = arr(p + 1, pos(0)) - arr(p + 1, pos(1))
      p = i
    End If
  Next
  Call doevent(False)
  With [a24]
    .Resize(UBound(arr, 1) * 2, UBound(arr, 2)).Clear
    With .Resize(UBound(arr, 1) - 1, UBound(arr, 2))
      .Borders.LineStyle = xlContinuous
      .Value = arr
    End With
  End With
  p = 24
  For i = 24 To [a24].End(xlDown).Row
    If Cells(i, "a").Value <> Cells(i + 1, "a").Value Or i = [a24].End(xlDown).Row Then
      For j = 0 To UBound(pos)
        Cells(p, pos(j)).Resize(i - p + 1).Merge
      Next
      p = i + 1
    End If
  Next
  Call doevent(True)
End Sub

Function doevent(flag As Boolean)
  With Application
    .DisplayAlerts = flag
    .ScreenUpdating = flag
  End With
End Function

deadzlq

Power Pivot汇总参考

孙惠彪

deadzlq 发表于 2020-5-29 15:17
Power Pivot汇总参考

好高深的样子，学习学习

孙惠彪

deadzlq 发表于 2020-5-29 15:17
Power Pivot汇总参考

我有点不淡定了

shenjianrong163

1. Sub test()
   
2.     Dim i%, j%, k1!, k2!, m%, r%, st, arr
   
3.     st = Array("H", "J", "K", "L", "M")
   
4.     With Sheets("Sheet1")
   
5.         arr = .Range("A1:M" & .Cells(.Rows.Count, 1).End(xlUp).Row + 1).Value
   
6.         m = 2
   
7.         For i = 2 To UBound(arr) - 1
   
8.             If arr(i, 1) <> arr(i + 1, 1) Then
   
9.                 If i - m > 0 Then
   
10.                     For j = 0 To UBound(st)
    
11.                         .Range(st(j) & m & ":" & st(j) & i).Merge
    
12.                     Next
    
13.                     For j = m To i
    
14.                         k1 = k1 + arr(j, 7)
    
15.                         k2 = k2 + arr(j, 9)
    
16.                     Next
    
17.                     arr(m, 8) = k1: arr(m, 10) = k2: k1 = 0: k2 = 0
    
18.                     arr(m, 12) = "=H" & m & "+K" & m
    
19.                     arr(m, 13) = "=L" & m & "-J" & m
    
20.                 Else
    
21.                     arr(i, 8) = arr(i, 7): arr(i, 10) = arr(i, 9)
    
22.                     arr(i, 12) = "=H" & m & "+K" & m
    
23.                     arr(i, 13) = "=L" & m & "-J" & m
    
24.                 End If
    
25.                 m = i + 1
    
26.             End If
    
27.         Next
    
28.         .[A1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
29.     End With
    
30. End Sub

复制代码

shenjianrong163

请参考附件：


工作簿1.rar (14.08 KB, 下载次数: 7)

2020-5-29 16:16 上传

点击文件名下载附件