二维表转换成一维表

gototom

谢谢各位大神老师！

lizhipei78

WPS 中使用

1. function 二转一(){
   
2.         res=Sheets(1).Range("A1").CurrentRegion().slice(1).reduce((p,x)=>{
   
3.                 p.push([x[0],x[1]]);x.slice(2).map(y=>p.push([,y]));return p;       
   
4.         },[["题干","选项"]]);       
   
5.         Sheets(2).Cells.ClearContents();
   
6.         Sheets(2).Range("A1").Resize(res.length,2).Value2=res;
   
7. }

复制代码

翁知江安

Sub zhuanhuan()
Dim i, m, k, j, irow, icolumn
Dim ar, br
irow = Sheet1.[a1000].End(xlUp).Row
icolumn = Sheet1.[iv2].End(xlToLeft).Column
ar = Sheet1.Range("a1:e" & irow)
ReDim br(1 To 1000, 1 To 2)
For i = 2 To irow
   m = m + 1
   br(m, 1) = ar(i, 1)
  For j = 2 To icolumn
   k = k + 1
   br(k, 2) = ar(i, j)
   Next
   m = k
Next
Sheet2.[a1].Resize(100, 2).ClearContents
Sheet2.[a1].Resize(1, 2).Copy Sheet2.[d1]
Sheet2.[d2].Resize(k, 2) = br
End Sub

翁知江安

供参考，欢迎批评指正。

飞天篮球猪

仅供参考...

悠扬的旋律

插入3空白列然后多列转2列

守候_CJ

示例代码

1. Sub 题库格式转换()
   
2.     Dim i As Long, j As Long, k As Long
   
3.     Dim sht As Worksheet
   
4.     Dim sht1 As Worksheet
   
5.    
   
6.     Set sht1 = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
   
7.     With sht1
   
8.         .Name = "结果" & Format(Now, "\_yyyymmddhhmmss")
   
9.         .Range("A1:B1").Value = Array("题干", "答案")
   
10.     End With
    
11.    
    
12.     Set sht = ThisWorkbook.Worksheets(1)
    
13.    
    
14.     i = 2
    
15.     k = 1
    
16.    
    
17.     Do While sht.Range("A" & i).Value <> ""
    
18.         j = 2
    
19.         Do While sht.Cells(i, j).Value <> ""
    
20.             k = k + 1
    
21.             
    
22.             '题干
    
23.             If j = 2 Then
    
24.                 sht1.Cells(k, 1).Value = sht.Cells(i, 1).Value
    
25.             End If
    
26.             
    
27.             sht1.Cells(k, 2).Value = sht.Cells(i, j).Value
    
28.             
    
29.             j = j + 1
    
30.         Loop
    
31.         
    
32.         i = i + 1
    
33.     Loop
    
34.    
    
35.     MsgBox "完成！"
    
36. End Sub

复制代码