怎样每例的符合条件的数据按照要求提取到一起

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.17
   
2.     With Sheets("Sheet3")
   
3.         r = .Cells(Rows.Count, 1).End(3).Row
   
4.         arr = .[a1].Resize(r, 12)
   
5.         ReDim brr(1 To r, 1 To 1)
   
6.         For i = 2 To UBound(arr)
   
7.             m = m + 1
   
8.             st = arr(1, 2) & arr(i, 2)
   
9.             st = st & arr(1, 3) & arr(i, 3) & "管理费欠费："
   
10.             For j = 4 To 11
    
11.                 If arr(i, j) <> 0 Then
    
12.                     st = st & Replace(arr(1, j), "管理费", "") & arr(i, j) & "元；"
    
13.                 End If
    
14.             Next
    
15.             If Right(st, 1) = "；" Then st = Left(st, Len(st) - 1)
    
16.             brr(m, 1) = st: st = ""
    
17.         Next
    
18.         .[l2].Resize(m, 1) = brr
    
19.     End With
    
20. End Sub
    

复制代码

saghj

交个作业。。。

小小小酥

刚刚没说清楚，重新更新的图片和附件

沈默00

="用户名:"&B2&"地址:"&C2&","&"管理费欠费:"&CONCAT(IF(D2:K2>0,D1:K1&":"&D2:K2&"元"&";",""))

yanglinzi

1. Sub 整理格式()
   
2. Dim arr, i, j, r
   
3. With Sheet1
   
4.     r = .Cells(Rows.Count, 2).End(xlUp).Row
   
5.     arr = .Range("a1:l" & r)
   
6. End With
   
7. For i = 2 To UBound(arr)
   
8.     For j = 4 To UBound(arr, 2) - 1
   
9.         sa = "用户名" & arr(i, 2)
   
10.         sb = arr(1, 2) & arr(i, 3)
    
11.         If Len(arr(i, j)) > 1 Then
    
12.             sc = sc & Left(arr(1, j), 5) & arr(i, j) & "元；"
    
13.         End If
    
14.         arr(i, 12) = sa & sb & "管理费欠费：" & sc
    
15.     Next
    
16.     sc = ""
    
17. Next
    
18. Sheet1.UsedRange = arr
    
19. End Sub
    

复制代码

yanglinzi

请测试。。

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br, i&, j&, r&, strJoin$
   
    Application.ScreenUpdating = False
    r = Cells(Rows.Count, "B").End(xlUp).Row
    ar = Range("B1:K" & r).Value
    ReDim br(1 To UBound(ar), 0)
    br(1, 0) = "目标信息合计"
   
    For i = 2 To UBound(ar)
        br(i, 0) = br(i, 0) & "用户名" & ar(i, 1) & ar(i, 2) & "管理费欠费："
        strJoin = ""
        For j = 3 To UBound(ar, 2)
            If Val(ar(i, j)) Then strJoin = strJoin & ";" & Replace(ar(1, j), "管理费", "") & ar(i, j) & "元"
        Next j
        strJoin = Mid(strJoin, 2)
        br(i, 0) = br(i, 0) & strJoin
    Next i
   
    [L1].Resize(UBound(br)) = br
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

参与一下。。。

小小小酥

沈默00 发表于 2024-5-17 16:45
="用户名:"&B2&"地址:"&C2&","&"管理费欠费:"&CONCAT(IF(D2:K2>0,D1:K1&":"&D2:K2&"元"&";",""))

我刚才试了一下，没成功，显示错误

沈默00

小小小酥 发表于 2024-5-18 15:55
我刚才试了一下，没成功，显示错误

365版的函数，WPS可以用，
看下是不是你的EXCEL版本不够高，，，