求VBA汇总排列问题的解决方法

shibaideren

求VBA汇总排列问题的解决方法

见附件！

songshihai

公式可以不,好像不用VBA也很简单

abc123281

Sub test()
Dim arr
With Worksheets("Sheet1")
  arr = .Range("a1").CurrentRegion
  For j = 1 To UBound(arr, 2)
    For i = 2 To UBound(arr)
      If Len(arr(i, j)) <> 0 Then
        s = s & arr(1, j) & arr(i, j) & "  "
      End If
    Next
  Next
  .Range("a" & UBound(arr) + 2) = s
End With
End Sub

ww87725244

1. Sub aa()
   
2. Dim ar, i, k, s
   
3. With Sheet1
   
4.     ar = .Range("a1:e6")
   
5.     For i = 2 To UBound(ar)
   
6.         For k = 1 To UBound(ar, 2)
   
7.             If ar(i, k) <> "" Then
   
8.                 s = s & ar(1, k) & ar(i, k) & " "
   
9.             End If
   
10.         Next
    
11.     Next
    
12.     MsgBox s
    
13. End With
    
14. End Sub

复制代码

shibaideren

abc123281 发表于 2024-8-3 14:23
Sub test()
Dim arr
With Worksheets("Sheet1")

没这简单，还有排序问题呢

shibaideren

abc123281 发表于 2024-8-3 14:23
Sub test()
Dim arr
With Worksheets("Sheet1")

C B E A D  行出现的顺序，老师

shibaideren

songshihai 发表于 2024-8-3 14:18
公式可以不,好像不用VBA也很简单

函数好像不行吧，这里面还有一个按出现的顺序呢  C B E A D
按顺序排序

Qs18

Sub qs()
Dim arr, i, j
With Sheet1
    rw = .Range("A1").CurrentRegion.Rows.Count
    arr = .Range("a1:e" & rw)
    ReDim brr(1 To UBound(arr, 2))
For j = 1 To UBound(arr, 2)
    sm = 0
    For i = 2 To UBound(arr)
        sm = sm + arr(i, j)
    Next
    brr(j) = arr(1, j) & sm
Next
.Range("a" & rw + 1).Value = VBA.Join(brr)
End With
Beep
End Sub

Qs18

试试........

Qs18

试试.........