请教多个文件转置批处理

as167888

我在同一个目录下，有几百个相同的excel文件，格式如下：

我想批量把这些excel文件的行和列全部转置，我在论坛上已经找到了一段excel2003的VBA代码：

Sub macro()
'----------1、找文件
Dim fs, mypath, Frfilename
On Error Resume Next
Application.ScreenUpdating = False
    mypath = ThisWorkbook.Path
    Frfilename = "*.xls"

    Set fs = Application.FileSearch
    With fs
        .NewSearch
        .SearchSubFolders = True
        .LookIn = mypath
        .Filename = Frfilename
        If .Execute(SortBy:=msoSortByFileName) > 0 Then
            n = .FoundFiles.Count
            For i = 1 To n
              '---------------转换
                 Transformer .FoundFiles(i)
            Next
        End If
    End With
    Set fs = Nothing
Application.ScreenUpdating = True
End Sub
Function Transformer(ByVal pth As String)
If pth = ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name Then Exit Function
Dim xarr, yarr, i%, j%, Numb%
Workbooks.Open (pth)
With ActiveWorkbook
Numb = Range("IV1").End(xlToLeft).Column
ReDim xarr(1 To 2, 1 To Numb), yarr(1 To Numb, 1 To 2)
xarr = Range("A1", Cells(2, Numb))
For i = 1 To 2
For j = 1 To Numb
yarr(j, i) = xarr(i, j)
Next
Next
Cells.Clear
Range("A1", Cells(Numb, 2)) = yarr
.Close True
End With
End Function


该帖子链接如下：http://club.excelhome.net/thread-481392-1-1.html

但是这个代码只是转置第一列的，我想转置第一第二列或者只转置第二列，请问各位代码应该如何修改呢？
excel文件在这： 2014-08-25-09-B4-1.zip (15.33 KB, 下载次数: 15)

2014-9-4 20:32 上传

点击文件名下载附件

liulang0808

能在附件里说明一下，你的转置是怎么个规则？
用示例说明

as167888

liulang0808 发表于 2014-9-4 20:35
能在附件里说明一下，你的转置是怎么个规则？
用示例说明

转置前后示例.zip (26.08 KB, 下载次数: 12)

2014-9-4 20:43 上传

点击文件名下载附件

转置前后示例如下，感谢您的帮助！

liu-aguang

as167888 发表于 2014-9-4 20:43
转置前后示例如下，感谢您的帮助！

excel 基本的使用操作:复制--粘贴(选"转置")

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    arr = Application.Intersect(ActiveSheet.UsedRange, Columns("a:b"))
    Sheets(3).Cells(1, 1).Resize(2, UBound(arr)) = WorksheetFunction.Transpose(arr)
    Application.ScreenUpdating = True
End Sub

liulang0808

附件请参考

as167888

liulang0808 发表于 2014-9-4 20:50
附件请参考

我是在同一个目录下边有大量的这样的excel文件，我想用VBA一下子把这些文件全部转置，然后保存，请问怎么做呢？

liulang0808

as167888 发表于 2014-9-4 20:52
我是在同一个目录下边有大量的这样的excel文件，我想用VBA一下子把这些文件全部转置，然后保存，请问怎么 ...

dir 或者用fso遍历文件夹下的文件，打开转置后保存
看你原始数据在那个表里，然后转置结果放到哪个表里

as167888

liulang0808 发表于 2014-9-4 20:50
附件请参考

上面那段代码可以遍历目录下所有excel文件，然后转置第一列，我想转置第二列，请问可以怎么修改呢？

liulang0808

http://club.excelhome.net/blog-238368-1694.html fso的一个使用案例，你可以参照下
http://club.excelhome.net/blog-238368-1693.html  fso的资料供参考