Question

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

但目前它从file1.txt复制数据并将数据分别粘贴到“E4”，“H4”，“K4”，“N4”..等（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

Answer 1

您需要移除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

excel定义多个变量

1 个答案: