多列转双列

YYKK001

今铭昔

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。
Sub CombineColumns1()
    'updateby Extendoffice
    Dim xRng As Range
    Dim i As Integer
    Dim xLastRow As Integer
    Dim xTxt As String
'    On Error Resume Next
    xTxt = Application.ActiveWindow.RangeSelection.Address
    Set xRng = Application.InputBox("请选择区域", "多列转两列", xTxt, , , , , 8)
    If xRng Is Nothing Then Exit Sub
    ReDim arr(1 To 10000, 1)
    brr = xRng
    xLastRow = xRng.Columns(1).Rows.Count + 1
    For j = 1 To xRng.Columns.Count
        For i = 2 To xRng.Rows.Count
            If brr(i, j) <> Empty Then
                n = n + 1
                arr(n, 0) = brr(1, j)
                arr(n, 1) = brr(i, j)
            End If
        Next
    Next
    Set xRng = Application.InputBox("请选择区域", "输出位置", xTxt, , , , , 8) '点击一个单元格，输出位置
    xRng.Resize(n, 2) = arr
End Sub

gwjkkkkk

高版本函数

1. =TOCOL(A2:D5,,1)&""

复制代码

1. =DROP(REDUCE("",L2:O2,LAMBDA(x,y,IF(y=0,x,VSTACK(x,IF({1,0},y,FILTER(OFFSET(y,1,,3),OFFSET(y,1,,3)<>0)))))),1)

复制代码

飞天篮球猪

仅供参考...

ykcbf1100

参与一下。。。

ykcbf1100

1. Sub ykcbf()   '//2025.4.15
   
2.     With Sheets("Sheet1")
   
3.         arr = Intersect(.UsedRange, .[l:o])
   
4.         ReDim brr(1 To UBound(arr) * 10, 1 To 2)
   
5.         For j = 1 To UBound(arr, 2)
   
6.             If arr(2, j) <> Empty Then
   
7.                 For i = 3 To UBound(arr)
   
8.                     If arr(i, j) <> Empty Then
   
9.                         m = m + 1
   
10.                         brr(m, 1) = arr(2, j)
    
11.                         brr(m, 2) = arr(i, j)
    
12.                     End If
    
13.                 Next
    
14.             End If
    
15.         Next
    
16.         .[q:r] = Empty
    
17.         .[q2].Resize(m, 2) = brr
    
18.     End With
    
19. End Sub
    

复制代码

limonet

let
    源 = Excel.CurrentWorkbook(){[Name="表1"]}[Content],
    筛选列 = Table.RemoveColumns(源,List.Select(Table.ColumnNames(源), each List.RemoveNulls(Table.Column(源,_))={})),
    转换列 = List.Transform(Table.ToColumns(筛选列),(x)=>List.TransformMany({x{0}},each List.RemoveFirstN(List.RemoveNulls(x)),(x,y)=>{x,y})),
    成表 = Table.FromColumns(List.Zip(List.Combine(转换列)))
in
    成表

limonet

Transform