ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: 守柔

[Word 应用与开发] [第8期] 表格行列转置[已完成]

[复制链接]

TA的精华主题

TA的得分主题

发表于 2006-2-13 14:31 | 显示全部楼层

方法一:

1、全选表格,表格——拆分单元格,列数选11,行数选1;

2、绘制表格,将表格分成15行。

方法二:


**********************************************************

Rongjun兄的代码:

Private Sub CommandButton1_Click()
Dim a, b As Integer
Application.ScreenUpdating = False
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
a = Tables(1).Columns.Count
b = Tables(1).Rows.Count
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=a, NumColumns _
:=b, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With Tables(3)
.Style = "网格型 1"
.ApplyStyleHeadingRows = False
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = False
.ApplyStyleLastColumn = True
End With
For i = 1 To a
Tables(1).Columns(i).Select
Selection.Copy
Tables(3).Rows(i).Select
Selection.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:= _
wdInLine, DisplayAsIcon:=False
Next
Application.ScreenUpdating = True
End Sub
常规操作是用绘制的方法,VBA是用列COPY的方法,简单易行.

[此贴子已经被守柔于2006-2-25 8:12:34编辑过]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?免费注册

x

TA的精华主题

TA的得分主题

发表于 2006-2-14 12:25 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

前面回了个用vba完成的.看到你的公告了,说不准用excel对象.因此改用表格转换的方法做了一个.不过方法比较笨就是了.

把原始表格拷到新文档下(便用选中).全选(ctrl+a),表格转换成文本--用段落标志;再用文本转换成表格--仍用段落标志,注意是1列,勾中"根据表格内容调整表格",自动套用格式,选用网格I型;现查找"数据1>",勾中"使用通配符",按Esc键(取消查找对话框),再使用拆分表格(不是拆分单元格)Alt+A接T;再查找,按Enter键两次(第一次是刚才找到的,要越过),在滚动条上点左键,按F4;如果再往复查找拆分9次,可把大表分成11个小表.按Ctrl+Home,回到文档开始.按Ctrl+PageDown,到达第n张表格的开头(n>1),再按Alt+A接C再接T,选中整个小表,用剪切,回到第一张表,将光标移到表格外侧的换行符上,还要保持在第一行以上,右击,选择"粘贴列";再如此往复10次,即可把11个表合成一张表.

把表拷回去,完工.有几处也许有更简捷的方法,但始终找不到办法,比如,能否用查找"数据1>"替换成"拆表符^&"(拆表符是我想的,就是直接拆表,而不表手式拆).

****************************

shuyee这个方法好象不简单哟!

[此贴子已经被守柔于2006-2-25 8:19:12编辑过]

TA的精华主题

TA的得分主题

发表于 2006-2-14 12:58 | 显示全部楼层

老大好!新年好!祝全家都好!

我的方法有三:

一、只用Word的前台功能

思路方法:

利用表格的排序功能,让“字段1”与“数据1”等的前面的字母相同,使排序时,使排到相应的后面。

实施步骤:

1、全选表格,表格、转换、表格转换为文本,文字分隔符选“段落标记”。

2、再把文本转换为表格,列数选1列,再在第一列的前面插入一列,在前十五行输入A-O,复制A-O(当然,也可以通过新建文档,输入=rand(15,1)来产生虚拟文本,按住alt+光标把文字去掉,再给他们加格式、项目符号和编号,自定义一个ABC样式的,再复制这十五个),再选中第一列,选择粘贴(如果是通过虚拟文本的,则是选择性粘贴、无格式文本)。

3、再把表格转换为文本,分隔符选默认的制表符。再表格、排序,用拼音、升序(这是默认的,不用改变的。)

4、用Alt+光标选中前面无关的字母加制表符再删除(当然,用替换也行,用查找:[A-O]^t,替换为无,勾选通配符),再表格,表格,文本转换为表格,选11列。再选“样式”为“网格型1

二、利用Excel的功能(前台)

思路方法:

与上面的同理,能利用排序功能,但无疑Excel自带的“转置”更好。

实施步骤:

选中表格,复制到Excel中,再复制(Ctrl+C),选中一个空的单元格,在选择编辑、选择性粘贴、转置。再复制表格加Word中,再选样式为“网格型1”。

三、Word中的VBA方法:

Sub 表格转置()

Dim arow%, acol%, 样式 As String

Dim airow%, aicol%

Dim ava() '定义一个数组

Debug.Print Timer

Application.ScreenUpdating = False

With Selection.Tables(1) '处理光格所在表格中

样式 = .Style '取得样式

arow = .Rows.Count '取得行数即11

acol = .Columns.Count '取得列数即15

ReDim ava(arow, acol) '确定数组的范围

For airow = 1 To arow '在行内循环

For aicol = 1 To acol

ava(airow, aicol) = Left(.Cell(airow, aicol).Range.Text, _

Len(.Cell(airow, aicol).Range.Text) - 2)

Next

Next

.Delete '删除

End With

Selection.Tables.Add Selection.Range, acol, arow

With Selection.Tables(1) '处理光格所在表格中

.Style = 样式 '定义样式

For aicol = 1 To acol

For airow = 1 To arow

.Cell(aicol, airow).Range.Text = ava(airow, aicol)

Next

Next

End With

Application.ScreenUpdating = True

Debug.Print Timer

End Sub

**************************************************

KONNGS:你的常规操作做得很有思路.

先前,我也是考虑用排序方式进行,但后来觉得不方便,没想到你的怪招真多啊,我在你基础上,加一个域,你以为如何?

域代码为: { SET B { SEQ A } }{ IF { =MOD({ B },15) } = 0 15 { =MOD({ B },15) } }

以数字方式排序,表格中新增首列后以此域代码作为填充后切断域链接,表格转文本,以数字方式对段落排序,再文字转为表格.

代码处理 是常规思路,更好的方式可以看一下我在一楼的点评,也是你在WORD版中回复时的收获.

[此贴子已经被守柔于2006-2-25 8:06:48编辑过]

TA的精华主题

TA的得分主题

发表于 2006-2-14 19:08 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

不用vba方法:

1. 原表为11*15列的表格,回车后插入一个15*11列的表格

2. 复制原表,在新建表格的后面粘贴为无格式文本,将文本中的制表符 ^9)替换为空格;将文本中的回车符(^13)替换为空格

3. 以空格为分隔符将文本转换为166*1列的表格,依次剪切粘贴1-1516-30……行到新建表格中完成表格的行列转置。


***************************************

就题而题,烦了些.也算对吧,呵呵.

[此贴子已经被守柔于2006-2-25 7:38:35编辑过]

TA的精华主题

TA的得分主题

发表于 2006-2-14 19:17 | 显示全部楼层

对VBA代码进行了优化,提高点速度

Sub rowTocolumn() 'by sailorgg 2006-2-14
Dim TableRows As Integer, TableColumns As Integer
Dim Nr As Integer, Nc As Integer
Dim TextTemp1 As String, TextTemp2 As String, TextTemp3 As String, TextTemp As Variant, FullArray() As Variant
Dim TempString As String, FullString As String
Dim myadd As Integer, Fi As Integer
Dim Myarry() As Variant
TableRows = Me.Tables(1).Rows.Count
TableColumns = Me.Tables(1).Columns.Count
ReDim Myarry(1 To TableColumns, 1 To TableRows)
TextTemp1 = Me.Tables(1).Range
TextTemp2 = VBA.Replace(TextTemp1, Chr(13), "")
TextTemp3 = VBA.Replace(TextTemp2, Chr(7) & Chr(7), Chr(7))
TextTemp = VBA.Split(TextTemp3, Chr(7))
myadd = 0
For Nc = 1 To TableRows
For Nr = 1 To TableColumns
Myarry(Nr, Nc) = TextTemp(Nr + TableColumns * myadd - 1)
Next
myadd = myadd + 1
Next
ReDim FullArray(1 To TableRows * TableColumns)
For Nr = 1 To TableColumns
For Nc = 1 To TableRows
Fi = Fi + 1
FullArray(Fi) = Myarry(Nr, Nc)
Next
Next
Selection.EndKey Unit:=wdStory
TempString = VBA.Join(FullArray)
FullString = VBA.Left(TempString, VBA.Len(TempString) - 1)
Selection.TypeText Text:="行列转换后的结果"
Selection.InsertAfter FullString

Selection.ConvertToTable Separator:=4, NumColumns:=TableRows, NumRows:=TableColumns, AutoFitBehavior:=wdAutoFitFixed
With Me.Tables(2)
.Style = "网格型"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With

End Sub

***********************************************************
sailorgg的精益求精的务实作风值得赞赏!

如果单元格中的数据为空,你试一下运行的结果.

[此贴子已经被守柔于2006-2-25 7:34:32编辑过]

TA的精华主题

TA的得分主题

发表于 2006-2-15 21:48 | 显示全部楼层

版主漏了一个“不”字,以为过年要送分,结果还是要动脑筋[em06],只好

先做个答案,不知行不行?

方法一:

第一步:将原表格复制到空白处,选中全表

第二步:点右键,合并单元格,再按shift+←键选中内容

第三步:点右键,拆分单元格,输入:列为11,行为1

第四步:在每行之间添加横线

TA的精华主题

TA的得分主题

发表于 2006-2-15 22:13 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

再答一个方法,虽繁了点,但可以用:

方法二:

第一步:选中原表的第一列数据并复制,在空白处使用“编辑”菜单下的“选择性粘贴”命令,选择“无格式文本”进行选择性粘贴,然后打开“查找和替换”对话框。

第二步:在查找内容”框中输入“^p(回车符),在“替换为”框中输入“^t”(制表符),点击“全部替换”。

第三步:按上述方法将15列数据逐一复制、替换后列行转换

第四步:画一个15行,11列的空表

第五步:将上述内容复制,并选中空表全表,粘贴复制的内容。

************************************************

两种方法我一起给分了,都正确,只是显得不是特别简练,如果行数多的话,画线也麻烦,逐一替换也有累.

[此贴子已经被守柔于2006-2-25 7:29:55编辑过]

TA的精华主题

TA的得分主题

发表于 2006-2-16 16:07 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

不知道是不是最笨笨的方法……

***********************

兄台能告诉我,你用得是什么方法吗?我只看一个网页耶.

[此贴子已经被守柔于2006-2-25 7:37:09编辑过]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?免费注册

x

TA的精华主题

TA的得分主题

发表于 2006-2-18 13:33 | 显示全部楼层

Option Explicit
'守柔版主:
'使用基本操作的过程如下(Excel2002):
'1.在表格的下方插入一空白行,目的是后面粘贴的列与原表断开,不被原表干扰
'2.从表的第一列开始,剪切,复制到最后,直到最后一列,产生一个新表为1列165行
'3.选定新表格,表格转换成文本
'4.再将文本转化成表格,列数为11(即原表的行数)
'5.删除掉最初插入的空行
'6.完毕

'以下代码是根据上面的操作写成
Sub ConTable()
Dim OldRows%, OldColumns%
Dim clm As Column
Application.ScreenUpdating = False
OldRows = ThisDocument.Tables(1).Rows.Count
OldColumns = ThisDocument.Tables(1).Columns.Count
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
For Each clm In ThisDocument.Tables(1).Columns
clm.Select
Selection.Cut
Selection.EndKey Unit:=wdStory
Selection.Paste
Next
Selection.Tables(1).Select
Selection.Rows.ConvertToText Separator:=wdSeparateByParagraphs, NestedTables:=True
Selection.ConvertToTable Separator:=wdSeparateByParagraphs, NumColumns:=OldRows _
, NumRows:=OldColumns, AutoFitBehavior:=wdAutoFitFixed
With Selection.Tables(1)
.Style = "网格型"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
Selection.HomeKey Unit:=wdStory
Selection.Delete Unit:=wdCharacter, Count:=1
Application.ScreenUpdating = True
End Sub


如果QEE用兄能再深入一点点就更好了!

[此贴子已经被守柔于2006-2-25 7:25:44编辑过]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?免费注册

x

TA的精华主题

TA的得分主题

发表于 2006-3-26 14:08 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

用transpose函数就可以完成了.干吗用代码.....

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-4-17 06:53 , Processed in 0.054200 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表