Question

我希望编写一个高效的宏来最终在处理研究数据时节省大量时间。目标是使用合并数据创建一个主工作簿。

情况如下：

我有40个研究对象都有一个标题为主题编号的输出文件，格式为“Subject 1_OUTPUT.txt”（示例中“1”的范围是1到40）。
在每个输出文本文件中，有大约30列特定于主题的数据......并且列标题在所有40个主题文件之间是相同的，并且顺序相同（例如：列A在主题1的文件，主题2的文件等中标题为“OutputDataObject1”。

终极目标：创建一个主Excel文件，该文件具有为主题文件中的每个列标题命名的选项卡（例如：OutputDataObject1，OutputDataObject2等），并且在每个选项卡中，每个选项卡都有一列主题及其数据列在列中。因此，每个选项卡在一个选项卡上将包含所有40个主题的一对一数据。

宏的逻辑：

打开每个主题txt文件（主题＃1到主题＃40）
将主题txt文件中的每一列复制到主工作簿上与数据对象名称相同的选项卡...并根据主题编号（主题1到40）复制到该选项卡上的相应主列中< / LI>

我知道这是可行的，但我正在努力创建嵌套循环以打开，将列与选项卡名称匹配，然后找到主题的特定列以粘贴到主工作簿中。

更新10-16-15：我用我的循环解决了问题 - 低于工作代码：）

Dim MasterWB As Workbook
Dim OpenWB As Workbook
Dim cur_subjectname As String
Dim cur_filename As String
Dim cur_source_column As Integer 
Dim cur_subject_number As Integer 
Dim MasterWB_sheetcount As Integer 'to cycle through MasterWB
Dim cur_sheetnumber As Integer 'to cycle through MasterWB
Dim S As Integer
Dim I As Integer 'to cycle through MasterWB
Dim cur_subjectoffset As Integer
Dim Cell As Range

Application.DisplayAlerts = False
Application.ScreenUpdating = False
cur_source_column = 0
cur_subject_number = 1 'tied to master WB column #
cur_sheetnumber = 3 'first tab to populate subject data
cur_subjectoffset = 0 'to move down "Subject_List" tab of subjects

Set MasterWB = ThisWorkbook
MasterWB_sheetcount = MasterWB.Worksheets.Count - 3

MasterWB.Worksheets("Subject_List").Activate 'first subject number in A2
cur_subjectname = Sheets("Subject_List").Range("A1").Offset(cur_subject_number, 0).Value

'Outside Loop - open each workbook, starting with Subject #1
For S = 1 To 45 'Change for Total # of Subjects
    cur_filename = ThisWorkbook.Path & "/" & cur_subjectname & "_OUTPIV.xlsx" 'Change for different data types
    If Len(Dir(cur_filename)) = 0 Then

    Else 'load data to MasterWB (ThisWorkbook)
        Set OpenWB = Workbooks.Open(cur_filename)
        For I = 1 To MasterWB_sheetcount
            OpenWB.Sheets(1).Range("B6:B110").Offset(, cur_source_column).Copy
            MasterWB.Sheets(cur_sheetnumber).Range("A2").Offset(, cur_subject_number).PasteSpecial
            cur_source_column = cur_source_column + 1
            cur_sheetnumber = cur_sheetnumber + 1
        Next I
        OpenWB.Close
    End If
    'Reset values and Move to next Subject
    cur_subject_number = cur_subject_number + 1
    cur_source_column = 0
    cur_sheetnumber = 3
    MasterWB.Worksheets("Subject_List").Activate 'first subject number in A2
    cur_subjectname = Sheets("Subject_List").Range("A1").Offset(cur_subject_number, 0).Value

Next S

打开各种文本文件并将列复制到主工作簿

0 个答案: