Question

我有以下代码将132个不同excel文件的年降水量数据复制到一个大型数据集中。我有来自多个不同站点的降水数据，我将其放置在不同的列中，因此具有不同的col值。我还想匹配日期，因此rw值。但是，我得到的是我的sub没有定义，我不知道为什么。

Sub f()
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  Dim directory As String, fileName As String
  directory = "C:\Working-Directory\Precipdata"
  fileName = Dir(directory & "*.csv")
  Do While fileName <> ""
    Workbooks.Open (directory & fileName)
    With (Workbooks(directory & fileName))
      If Range("B2").Value = "GJOA HAVEN A" Then col = "B & rw :D & rw+lngth-27"
      If Range("B2").Value = "TALOYOAK A" Then col = "E & rw :G & rw+lngth-27"
      If Range("B2").Value = "GJOA HAVEN CLIMATE" Then col = "H & rw :J & rw+lngth-27"
      If Range("B2").Value = "HAT ISLAND" Then col = " & rw :M & rw+lngth-27"
      If Range("B2").Value = "BACK RIVER (AUT)" Then col = "N & rw :P & rw+lngth-27"
      yr = Range("B27").Value
      lngth = (Range("B27").End(xlDown).Row)
    End With
    Workbook(Macroforprecip.xlsm).Activate
    rw = Cells.Find("01/01/" & yr).Row
    Workbooks(fileName).Range("P&R&T" & (Range("B27").End(xlDown).Row)).Copy_Workbooks(Macroforprecip.xlsm).Range (col)
    Workbooks(fileName).Close
    fileName = Dir()
  Loop
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True

End Sub

另外我真的想要使用单元格功能，所以我可以将col设为数值而只添加两个但是我找不到如何做等效的Range（“”A“＆amp; i：”G“＆amp; amp ;我“）用它。

好的，所以我将其更新为稍微简单一些。我一次只复制一列，我确实将workbook（）函数更改为workbooks（）我的新代码看起来像这样。

Sub precipitation()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim directory As String, fileName As String
directory = "C:\Working-Directory\Precipdata\"
fileName = Dir(directory & "*.csv")
    Do While fileName <> ""
        sheetName = Left(fileName, Len(fileName) - 4)
        Workbooks.Open (directory & fileName)
        Workbooks(fileName).Activate
                If Range("B1").Value = "GJOA HAVEN A" Then
                col = "B"
                End If
                If Range("B1").Value = "TALOYOAK A" Then
                col = "E"
                End If
                If Range("B1").Value = "GJOA HAVEN CLIMATE" Then
                col = "H"
                End If
                If Range("B1").Value = "HAT ISLAND" Then
                col = "K"
                End If
                If Range("B1").Value = "BACK RIVER (AUT)" Then
                    col = "N"
                End If
            yr = Range("B27").Value
            lngth = (Range("B27").End(xlDown).Row)
       Workbooks("Macroforprecip.xlsm").Activate
           Set rw = ActiveSheet.Cells.Find(what:=DateValue("01/01/" & yr))
           r = rw.Row

       Workbooks(fileName).Range("P27", "P" & lngth).Copy_Workbooks("Macroforprecip.xlsm").Range (col & r)
       Workbooks(fileName).Close
       fileName = Dir()
    Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

我的新错误是我收到“运行时错误'438'：
Object不支持此属性或方法。“

这发生在实际复制“

”的Line上

(Workbooks(fileName).Range("P27", "P" & lngth).Copy_Workbooks("Macroforprecip.xlsm").Range (col & r)`

我不完全明白这意味着什么，甚至更多，所以我不明白该怎么办。感谢大家的帮助。

Answer 1

此行失败：

Workbook(Macroforprecip.xlsm).Activate

因为没有名为Workbook的函数。您可能打算使用应用程序工作簿集合，如下所示：

Workbooks("Macroforprecip.xlsm").Activate

Answer 2

我做了很多改变，因为有很多问题。看看这是否让你更近一点：

Sub f()
  Dim wb As Workbook ' define workbook object
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  Dim directory As String, fileName As String
  directory = "C:\Working-Directory\Precipdata\" ' added backslash
  fileName = Dir(directory & "*.csv")
  Do While fileName <> ""
    Set wb = Workbooks.Open(directory & fileName) ' set a workbook object
    With wb ' use workbook object instead
      If Range("B2").Value = "GJOA HAVEN A" Then col = "B" & rw & ":D" & rw + lngth - 27 ' fixed
      If Range("B2").Value = "TALOYOAK A" Then col = "E" & rw & ":G" & rw + lngth - 27 ' fixed
      If Range("B2").Value = "GJOA HAVEN CLIMATE" Then col = "H" & rw & ":J" & rw + lngth - 27 ' fixed
      'If Range("B2").Value = "HAT ISLAND" Then col = " & rw :M & rw+lngth-27" ' missing column so removed
      If Range("B2").Value = "BACK RIVER (AUT)" Then col = "N" & rw & ":P" & rw + lngth - 27
      yr = Range("B27").Value
      lngth = (Range("B27").End(xlDown).Row)
      .Activate
      'Workbook(Macroforprecip.xlsm).Activate ' moved into the With
      rw = Cells.Find("01/01/" & yr).Row
      wb.Range("P&R&T" & (Range("B27").End(xlDown).Row)).Copy wb.Range(col) ' not sure what you are trying to do here
    End With
    wb.Close
    fileName = Dir()
  Loop
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True

End Sub

子或函数未定义从一个文件复制粘贴到另一个文件

2 个答案: