|
|
楼主 |
发表于 2010-7-12 17:50
|
显示全部楼层
原帖由 ybf007007 于 2010-7-12 16:11 发表 
LZ你好
你教的方法我会用了，但是还是实在看不懂你第二张表格是怎么弄出来的
1楼附件中使用的代码：
Sub 利用设置单元颜色配合记录表转置() '当前数据表第1行为标题行，需要重复记录的字段名称设置为浅灰色单元
Application.Calculation = xlCalculationManual '手动重算
'清空表2
Sheet2.Cells.ClearContents
'记录标题行
Sheet2.Range("a1") = "转置标题" '表2为转置结果表，表2的A列放置转置标题
Sheet2.Range("b1") = "转置数据" '表2为转置结果表，表2的B列放置转置数据
aa = Range("IV1").End(xlToLeft).Column '第1行最后列号
For a = 1 To aa '循环标题行到最后列
If Cells(1, a).Interior.ColorIndex = 15 Then '如果单元颜色为灰色，则
b = Sheet2.Range("IV1").End(xlToLeft).Column '表2第1行最后列号
Sheet2.Cells(1, b + 1) = Cells(1, a).Value '将标题内容记录到表2
End If
Next
'记录
For c = 2 To [a65536].End(xlUp).Row '循环数据行
t = 0 '有效数据初始
For d = 1 To aa '循环该行各列,记录转置列数据
If Cells(1, d).Interior.ColorIndex <> 15 And Cells(c, d).Value <> "" Then '如果该列第1行不是灰色,且该单元不是空值，则
e = Sheet2.[a65536].End(xlUp).Row '表2A列最后行号
Sheet2.Cells(e + 1, 1) = Cells(1, d).Value '记录转置标题
Sheet2.Cells(e + 1, 2) = Cells(c, d).Value '记录转置数据
t = t + 1 '该行转置列有效数据数量加1
End If
Next
For f = 1 To aa '循环该行各列，记录重复列数据
If Cells(1, f).Interior.ColorIndex = 15 Then '如果该列第1行是灰色，则
h = Sheet2.Range("1:1").Find(Cells(1, f).Value).Column '在表1查找标题返回列号
g = Sheet2.Cells(65536, h).End(xlUp).Row '该列最后行号
If Cells(c, f).Value <> "" Then
Sheet2.Range(Sheet2.Cells(g + 1, h), Sheet2.Cells(g + t, h)) = Cells(c, f).Value '将重复数据记录到多行
End If
If Cells(c, f).Value = "" Then
Sheet2.Range(Sheet2.Cells(g + 1, h), Sheet2.Cells(g + t, h)) = "空" '重复数据如果为空，则记录文本“空”
End If
End If
Next
Next
Application.Calculation = xlCalculationAutomatic '自动重算
End Sub |
|
楼主: LangQueS
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2010-5-29 00:02
