郁闷了很久的问题---需将大量表格转换格式（横转竖）请大家帮忙呀！！

xxallall · 发表于 2010-5-6 15:01

需要将表格按涂色部份转换格式，试过一些方法都不行，只能1个1个复制粘贴，痛苦呀！！！

besteclily · 发表于 2010-5-6 15:18

不太明白你的意思，不过行列转换可以通过选择性黏贴中的转置功能实现

抹香鲸2009 · 发表于 2010-5-6 17:06

是不是这样。

xxallall · 发表于 2010-5-7 09:42

你没有注意到一个型号是有很多尺码的，如果是用转置的话还要再复制型号才能呀，而且按你的方法要一行一行转置呀，如果我有1000多行呢？是不是没有办法了，请大家帮帮忙呀！经常要做这样的表格呀
！

抹香鲸2009 · 发表于 2010-5-7 09:58

要是这样，直接透视就可以了。如果楼主经常要用到这张表，建议修改表的格式。也就是你要求得到的那样，平时输入数据。期末用透视表汇总就可以了。

楼主的表很不规范。表头中的字段有很多空格。看起来都累。为了便于透视，我将表头字段中间的空白去掉。导入外部查询，语句如下：
select 型号,[宽度/色号],"010" as 尺码,010 as 值 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"020",020 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"025",025 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"030",030 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"035",035 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"040",040 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"045",045 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"050",050 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"055",055 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"060",060 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"065",065 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"070",070 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"075",075 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"080",080 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"085",085 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"090",090 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"095",095 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"100",100 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"105",105 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"110",110 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"120",120 from [订单$A1:Y5] union all
select 型号,[宽度/色号],"130",130 from [订单$A1:Y5]

[ 本帖最后由抹香鲸2009 于 2010-5-7 11:16 编辑 ]

xxallall · 发表于 2010-5-7 16:16

非常感谢，努力学习中！

alzeng · 发表于 2010-5-7 17:15

用VBA加Sql试着解决一下：

Sub NewSht()
Dim Cn As Object, Sqlstr$
Dim Arr, Ary, k%, i%
Ary = Sheets("订单").Range("A1", Sheets("订单").[A1].End(2))
Sheets("订单").[A1].CurrentRegion.Name = "Data1"
Set Cn = CreateObject("Adodb.Connection")
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
Sqlstr = "Select Distinct 型号 From Data1"
Arr = Application.Transpose(Cn.Execute(Sqlstr).Getrows)
With Sheets("Sheet2")
.[A:D].Clear
For k = 1 To UBound(Arr)
For i = 4 To UBound(Ary, 2)
Sqlstr = "Select 型号,[宽度/色号] & ' " & Ary(1, i) & "' As 尺码,Sum([" & Ary(1, i) & "]) as 数量 " _
& "From Data1 " _
& "Where 型号='" & Arr(k, 1) & "' " _
& "Group By 型号,[宽度/色号] " _
& "Having Sum([" & Ary(1, i) & "]) > 0"
.[A65536].End(3)(2).CopyFromRecordset Cn.Execute(Sqlstr)
Next
Next
Arr = .Range("A1", .[A65536].End(3)(1, 4))
For i = 0 To 3
Arr(1, i + 1) = Split("型号,宽度/色号,尺码,数量", ",")(i)
Next
For k = 2 To UBound(Arr)
Arr(k, 4) = Arr(k, 3)
Arr(k, 3) = Split(Arr(k, 2), " ")(1)
Arr(k, 2) = Split(Arr(k, 2), " ")(0)
Next
.[A1].Resize(k - 1, 4) = Arr
.[A1].Resize(k - 1, 4).Borders.LineStyle = 1
End With
ActiveWorkbook.Names("Data1").Delete
Cn.Close: Set Cn = Nothing
End Sub

复制代码

cbtaja · 发表于 2010-5-9 14:16

我测试楼上大侠的代码，运行出错，不知何故？
编了一个简陋的，测试通过，代码如下：

Sub NewSht()
Sheets("sheet2").Select
[A1] = "型号"
[B1] = "宽度/色号"
[C1] = "尺码"
[D1] = "数量"
k = 1
For i = 2 To Sheets("订单").Range("A1").SpecialCells(xlCellTypeLastCell).Row
      For j = 4 To Sheets("订单").Range("A1").SpecialCells(xlCellTypeLastCell).Column
         If Sheets("订单").Cells(i, j) <> "" Then
            k = k + 1
            Cells(k, 1) = Sheets("订单").Cells(i, 1)
            Cells(k, 2) = Sheets("订单").Cells(i, 2)
            Cells(k, 3) = Sheets("订单").Cells(1, j)
            Cells(k, 4) = Sheets("订单").Cells(i, j)
         End If
      Next j
Next i

End Sub

pzs0099大山 · 发表于 2010-5-11 16:02

复杂的问题，经过楼上的讲解，更容易理解了/

xxallall · 发表于 2010-5-13 15:21

大侠能否帮我再做一张表呀，我对代码是超级菜鸟呀

，只能一直拿出测试可不成功呀！谢谢帮忙！努力学习中

		自动登录	找回密码
密码			免费注册

[求助] 郁闷了很久的问题---需将大量表格转换格式（横转竖）请大家帮忙呀！！

回复 8楼 cbtaja 的帖子