求内容汇总到指定单元格

wzd028

运行VBA：把F、G、H、I、J、P列相关内容汇总到R列，样式见R列。

      001.rar (20.79 KB, 下载次数: 10)

2024-9-18 15:21 上传

点击文件名下载附件

cnmlgb9998

=$P4&":"&TEXTJOIN(",",TRUE,FILTER($G$3:$J$3&$G4:$J4&$F4,TRIM($G4:$J4)<>""))  下拉！365体验计划！

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.9.18
   
2.     With Sheets("月度使用计划表")
   
3.         r = .Cells(Rows.Count, 1).End(3).Row
   
4.         arr = .[a1].Resize(r, 18)
   
5.         For i = 4 To UBound(arr)
   
6.             st = ""
   
7.             For j = 7 To 10
   
8.                 If arr(i, j) <> Empty Then
   
9.                     st = st & "、" & arr(3, j) & arr(i, j) & arr(i, 6)
   
10.                 End If
    
11.             Next
    
12.             .Cells(i, 18).Value = arr(i, 16) & "：" & Mid(st, 2)
    
13.         Next
    
14.     End With
    
15.     MsgBox "OK！"
    
16. End Sub
    

复制代码

MHanys

~~~~~~~~~~~~~~~~~~~~~~~~~~

lcluck2002

附件供参考。。。+1

Qs18

1. Sub qs()
   
2. Dim arr, i
   
3. With Sheet1
   
4.     r = .Cells(Rows.Count, "f").End(3).Row
   
5.     arr = .Range("f2:p" & r).Value
   
6.     ReDim brr(1 To 100000, 1 To 1)
   
7.     For i = 3 To UBound(arr)
   
8.         s = ""
   
9.             For c = 2 To 5
   
10.                 If Len(arr(i, c)) > 0 Then
    
11.                    s = s & "、" & arr(2, c) & arr(i, c) & arr(i, 1)
    
12.                 End If
    
13.             Next
    
14.             s = Mid(s, 2)
    
15.             s = arr(i, 11) & "：" & s
    
16.         m = m + 1
    
17.         brr(m, 1) = s
    
18.    
    
19.     Next
    
20. .Range("r4").Resize(m, 1) = brr
    
21. End With
    
22. End Sub

复制代码

Qs18

试试.........

Qs18

试试.........

ylj518

参与一下，仅供参考