Microsoft Office Excel 2007
Excel VBA
'Sheet1'表是“名称”、“组件”2列数据表，其中第一列“名称”不同类有很多重复，第二列“组件”数量。把'Sheet1'表数据转成多列（不重复“名称”第一列，从第二列开始各列的相应”组件”数量列表）数据'Sheet2'表。
首先打开上例文件，如下图。
然后按下快捷键ALT+F11打开VBA（宏）编辑界面，然后点菜单栏【插入】下拉中列表中点【模块（M）】如图。
然后插入了一个模块1，在代码框中复制如下代码：Option Base 1Sub 表格转换() '2019-12-11 22:19:31 Dim myrange As Range, myrange1 As Range, m1, zhtj(), zhtj1(), i As Long, i1 As Long, j As Long, r As Long, n As Long, k As Long r = Range('a65536').End(xlUp).Row Set myrange1 = Range('a2:a' & r) m1 = Range('a2:b' & r) ReDim zhtj(myrange1.Count, 2) i = 0 For Each myrange In myrange1 If myrange.Value <> '' Then i = i + 1 If i = 1 Then zhtj(i, 1) = myrange.Value Else i1 = i For j = 1 To i - 1 If zhtj(j, 1) = myrange.Value Then i = i - 1: Exit For Next j If i1 = i Then zhtj(i, 1) = myrange.Value End If End If End If Next myrange For j = 1 To i zhtj(j, 2) = Application.WorksheetFunction.CountIf(myrange1, zhtj(j, 1)) Next j n = Application.WorksheetFunction.Max(Application.Index(zhtj, 0, 2)) ReDim zhtj1(i, n + 1) k = 1 For j = 1 To i For i1 = 1 To r - 1 zhtj1(j, 1) = zhtj(j, 1) If zhtj(j, 1) = m1(i1, 1) Then k = k + 1 zhtj1(j, k) = m1(i1, 2) End If Next i1 k = 1 Next j Sheets('Sheet2').Range(Sheets('Sheet2').Range('a2'), Sheets('Sheet2').Range('a2').Offset(i - 1, n)) = zhtj1End Sub
回到工作表窗口，然后菜单栏中点【视图】中下列表中【宏】列表【查看宏(V)】打开宏对方框，选宏名“表转换 ”点【执行】，在Sheet2表生成结果。
操作过程和运行结果动态操作如下图：
下面修改下代码，做成万能式转换数据，选原数据（不含标题），然后运行宏【二列转多列】，提示选第一个单元格数据输出，然后在该单元格开始输出多列数据，代码如下：Sub 二列转多列()'2019-12-26 22:15:32 Dim n As Long, k As Long, m1, zhtj(), zhtj1(), i As Long, i1 As Long, j As Long, n1 As Long, myr As Range m1 = Selection n = UBound(m1, 1) ReDim zhtj(n, 2) i = 0 For k = 1 To n If m1(k, 1) <> '' Then i = i + 1 If i = 1 Then zhtj(i, 1) = m1(k, 1) Else i1 = i For j = 1 To i - 1 If zhtj(j, 1) = m1(k, 1) Then i = i - 1: Exit For Next j If i1 = i Then zhtj(i, 1) = m1(k, 1) End If End If End If Next k i1 = 0 For j = 1 To i For k = 1 To n If m1(k, 1) = zhtj(j, 1) Then i1 = i1 + 1 Next k zhtj(j, 2) = i1 i1 = 0 Next j n1 = Application.WorksheetFunction.Max(Application.Index(zhtj, 0, 2)) ReDim zhtj1(i, n1 + 1) k = 1 For j = 1 To i For i1 = 1 To n zhtj1(j, 1) = zhtj(j, 1) If zhtj(j, 1) = m1(i1, 1) Then k = k + 1 zhtj1(j, k) = m1(i1, 2) End If Next i1 k = 1 Next j Set myr = Application.InputBox(Prompt:='使用鼠标选择输出转换数据的一个单元格', Type:=8) Range(myr, myr.Offset(i - 1, n1)) = zhtj1End Sub
如果觉得这篇经验帮到了您，请点击下方的 “投票点赞' 或者“收藏”支持我！还有疑问的话可以点击下方的 “我有疑问”，谢谢啦！