着急求助，如何实现这种一行变多列变多行两列？

cwcwcwcw1234

如图所示，表格中列举了每个词的同义词，每个词的同义词数量不一，我想将这个表格中的所有词由一行多词变为多行两词，求问各位大神如何实现？
原格式：

安静	平静	宁和	宁静
安好	安全	安详	平安

要求格式：

安静	平静
安静	宁和
安静	宁静

blake996

感谢高手们支持

wj2368

。。。。。。。。。。。。。。。

看见星光

1. Sub kjxg()
   
2. arr = Sheets(1).[a1].CurrentRegion
   
3. ReDim brr(1 To Cells.Rows.Count, 1 To 2)
   
4. For i = 1 To UBound(arr)
   
5.     For j = 2 To UBound(arr, 2)
   
6.         If arr(i, j) <> "" Then
   
7.             k = k + 1
   
8.             brr(k, 1) = arr(i, 1)
   
9.             brr(k, 2) = arr(i, j)
   
10.             Else
    
11.             Exit For
    
12.         End If
    
13.     Next
    
14. Next
    
15. Sheets(2).[a1].Resize(k, 2) = brr
    
16. End Sub
    

复制代码

看见星光

参考 collected_syno(classified).zip (1014.7 KB, 下载次数: 76)

2016-3-4 10:32 上传

点击文件名下载附件

everbest2015

Sub gszh()
    Dim ar, i&, k&, br(), m&
    ar = Range("a1").CurrentRegion
    For i = 1 To UBound(ar)
        For k = 2 To UBound(ar, 2)
            If ar(i, k) <> "" Then
                m = m + 1
                ReDim Preserve br(1 To 2, 1 To m)
                br(1, m) = ar(i, 1)
                br(2, m) = ar(i, k)
            End If
        Next
    Next
     Sheet2.[a1].Resize(m, 2) = Application.Transpose(br)
End Sub

everbest2015

Sub gszh()
    Dim ar, i&, k&, br(), rr(), m&, t!, j&, n&
    t = Timer
    ar = Sheet1.Range("a1").CurrentRegion
    For i = 1 To UBound(ar)
        For k = 2 To UBound(ar, 2)
            If ar(i, k) <> "" Then
                m = m + 1
                ReDim Preserve br(1 To 2, 1 To m)
                br(1, m) = ar(i, 1)
                br(2, m) = ar(i, k)
            End If
        Next
    Next
    ReDim rr(1 To m, 1 To 2)
    For j = 1 To UBound(br, 2)
        n = n + 1
        rr(n, 1) = br(1, j)
        rr(n, 2) = br(2, j)
    Next
     Sheet2.[D1].Resize(m, 2) = Application.Transpose(br)
End Sub