0

我正在编写一个excel宏。我想要我的宏循环正好 100 次。在第一次迭代中，它读取一个名为 file1.txt 的文件。从中复制数据并将数据粘贴到一个主 Excel 文件单元格“E4”中。之后，它读取名为 file2.txt 的第二个文件并从中复制数据，然后将数据粘贴到主 Excel 文件单元格“H4”中。必须像这样进行 100 次迭代。

但目前它从file1.txt复制数据并将数据分别粘贴到“E4”、“H4”、“K4”、“N4”..etc（100次）。经过 100 次迭代后，它开始从 file2.txt 复制数据并再次粘贴到“E4”和“H4”、“K4”、“N4”……经过 100 次循环 file3.txt。

所以它总共进行 100x100 循环，并用最后一个文件覆盖所有结果。我只想要 100 个循环，并且每个文件的结果在不同的列中。我怎样才能做到这一点？对不起我的英语不好。

 Sub copy_files_macro()

 Dim y As Integer
 Dim fname As String
 Dim dirctry As String
 Dim profnum As Integer

Sheets("Start_Page").Select
dirctry = Range("A1").Value
fname = Range("A2").Value

ChDir (dirctry)
  For profnum = 1 To 100
  For y = 1 To 300 Step 3

    Workbooks.OpenText filename:= _
    fname & "file" & profnum & ".txt", Origin:=857, _
    StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(9, _
    1), Array(29, 1), Array(49, 1), Array(69, 1), Array(89, 1), Array(109, 1), Array(129, 1), _
    Array(149, 1), Array(168, 1), Array(188, 1), Array(209, 1), Array(229, 1), Array(249, 1), _
    Array(269, 1), Array(288, 1))
    TrailingMinusNumbers = True
Range("B3:C123").Select
Selection.Copy
Windows("main_excel_file.xlsx").Activate
Sheets("file_data").Select
Range("D4").Offset(0, y).Select
ActiveSheet.Paste
Windows(fname & "file" & profnum & ".txt").Activate
Application.CutCopyMode = False
ActiveWindow.Close

Next y
Next profnum
ActiveWorkbook.Save
End Sub
4

1 回答 1

0

您需要删除多余的循环y并替换Offset(0,y)为Offset(0,1+(profnum-1)*3)

这将给出以下内容：

Sub copy_files_macro()

 Dim fname As String
 Dim dirctry As String
 Dim profnum As Integer

  Sheets("Start_Page").Select
  dirctry = Range("A1").Value
  fname = Range("A2").Value

  ChDir (dirctry)
  For profnum = 1 To 100

    Workbooks.OpenText Filename:= _
    fname & "file" & profnum & ".txt", Origin:=857, _
    StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(9, _
    1), Array(29, 1), Array(49, 1), Array(69, 1), Array(89, 1), Array(109, 1), Array(129, 1), _
    Array(149, 1), Array(168, 1), Array(188, 1), Array(209, 1), Array(229, 1), Array(249, 1), _
    Array(269, 1), Array(288, 1))

    TrailingMinusNumbers = True
    Range("B3:C123").Select
    Selection.Copy
    Windows("main_excel_file.xlsx").Activate
    Sheets("file_data").Select
    Range("D4").Offset(0, 1 + (profnum - 1) * 3).Select
    ActiveSheet.Paste
    Windows(fname & "file" & profnum & ".txt").Activate
    Application.CutCopyMode = False
    ActiveWindow.Close

  Next profnum
  ActiveWorkbook.Save
End Sub
于 2013-09-05T09:07:13.010 回答