Question

我想要一个宏，它具有以下功能：

打开目录上的所有文件（超过600个文件）
修改I36和I37值
将I48复制到文件＆＃39; AKL LASER SUM W27_36 macro1.xls＆＃39; A3细胞
将L36复制到文件＆＃39; AKL LASER SUM W27_36 macro1.xls＆＃39; B3细胞
所有文件I48和L36在彼此之下不断复制到AKL LASER SUM W27_36 macro1.xls＆＃39;来自A3和B3的文件（所以下一个文件打开，修改I36和I37，复制后I48和L36复制到A4和B4）

有了这个，我可以很好地打开和修改所有文件，并且只复制单元格，但每次只复制到A3和B3，而不是彼此之下。

由于

Sub OpenAllWorkbooks()

    Dim MyFiles As String

    MyFiles = Dir("D:\GTMS\AKL Laser 4 W27_36\*.xls")
    Do While MyFiles <> ""

    Workbooks.Open "D:\GTMS\AKL Laser 4 W27_36\" & MyFiles


    Range("I36").Value = 2.03
    Range("I37").Value = 2.19

    Range("I48").Copy _
    Workbooks("AKL LASER SUM W27_36 macro1.xls").Worksheets("Munka1").Range("A3")

    Range("L36").Copy _
    Workbooks("AKL LASER SUM W27_36 macro1.xls").Worksheets("Munka1").Range("B3")

    MsgBox ActiveWorkbook.Name

    ActiveWorkbook.Close SaveChanges:=True

    MyFiles = Dir
    Loop

End Sub

Answer 1

如果您添加一个变量来跟踪您当前正在写入的行，则变得非常简单：

sepOuts <-
  lapply(seq(3, length(myList), 1), function(idx){

    out <-
      lapply(myList[c(1,2,idx)], function(x){
        as.matrix(x) %>%
          as.numeric()
      }) %>%
      as.data.frame()

    write.csv(out, paste0("fileNameLeader_"
                          , names(myList)[idx]
                          , "_anyTrailingName.csv"))

    return(out)
  }) %>%
  setNames(names(myList)[-c(1,2)])

我还稍微更改了代码，因此它不使用Sub OpenAllWorkbooks() Dim MyFiles As String Dim destRow As Long destRow = 3 MyFiles = Dir("D:\GTMS\AKL Laser 4 W27_36\*.xls") Do While MyFiles <> "" Workbooks.Open "D:\GTMS\AKL Laser 4 W27_36\" & MyFiles With ActiveWorkbook.Worksheets(1) .Range("I36").Value = 2.03 .Range("I37").Value = 2.19 Workbooks("AKL LASER SUM W27_36 macro1.xls").Worksheets("Munka1").Cells(destRow, "A").Value = .Range("I48").Value Workbooks("AKL LASER SUM W27_36 macro1.xls").Worksheets("Munka1").Cells(destRow, "B").Value = .Range("L36").Value destRow = destRow + 1 End With MsgBox ActiveWorkbook.Name ActiveWorkbook.Close SaveChanges:=True MyFiles = Dir Loop End Sub命令 - 如果用户在宏运行时正在执行任何使用剪贴板的操作，有时会导致问题。

Excel VBA宏单元格相互复制

1 个答案: