数据组合输出

转角处的沉思

quqiyuan 发表于 2024-7-31 15:10
参与一下，供参考。。。

感谢帮助，效果补充，鲜花明补。

转角处的沉思

liuyu5863016 发表于 2024-7-31 15:37
插楼

感谢帮助，鲜花明补，不过标题关键字段和数据源区域是不确定的，如能做成动太就更具适用性了。

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br, i&, j&, r&
   
    Application.ScreenUpdating = False
   
    With Intersect(ActiveSheet.UsedRange, Columns("B:I"))
        ar = .Value
        ReDim br(1 To UBound(ar) * UBound(ar, 2), 0) As String
    End With
    For j = 1 To UBound(ar, 2)
        For i = 3 To UBound(ar)
            If Len(ar(i, j)) Then
                r = r + 1
                br(r, 0) = ar(1, j) & ":" & ar(i, j)
            End If
        Next i
    Next j
   
    Columns("k").Clear
    [K1].Resize(r) = br
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

.............

longwin

参与一下：

转角处的沉思

gwjkkkkk 发表于 2024-7-31 19:14
Option Explicit
Sub TEST2()
    Dim ar, br, i&, j&, r&

运行效果很好，感谢帮助。

转角处的沉思

longwin 发表于 2024-7-31 21:26
参与一下：

运行效果很好，感谢帮助。