通过检查单元格从一个工作簿复制到另一个工作簿

Question

我正在尝试将一些数据从一个工作簿复制到另一个工作簿，并检查 2 个文件中的某些单元格内容。以下是我的代码：

    Sub GetFileCopyData()
   Dim Fname As String
   Dim SrcWbk As Workbook
   Dim DestWbk As Workbook
   Dim miesiac() As Variant
   Dim m_i, i, wiersz_nazw As Integer
   Dim Msc, nazw As String

   miesiac = Array(styczeń, luty, marzec, kwiecień, maj, czerwiec, lipiec, sierpień, wrzesień, październik, listopad, grudzień)

   Set DestWbk = ThisWorkbook
   Set SrcWbk = ActiveWorkbook
   Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
   If Fname = "False" Then Exit Sub
   Set SrcWbk = Workbooks.Open(Fname)
   Set DestWbk = ActiveWorkbook


   Msc = SrcWbk.Cells(2, 13).Text
   m_i = szukaj(miesiac, Msc)


   nazw = Cells(3, 4).Text
   For i = 1 To 100 Step 1
        If nazw Like "*" & SrcWbk.Cells(i, 24) & "*" Then
            wiersz_nazw = i: Exit For
        End If
   Next

   SrcWbk.Cells(wiersz_nazw, 2).Copy DestWbk.Cells(m_i + 7, 3)

End Sub

Function szukaj(ByRef lista As Variant, ByVal wartosc As String)
  Dim found As Integer, foundi As Integer ' put only once
  found = -1
  For foundi = LBound(lista) To UBound(lista):
   'If lista(foundi) = wartosc   Then
   If StrComp(lista(foundi), wartosc, vbTextCompare) = 0 Then
    found = foundi: Exit For
   End If
  Next
  szukaj = found
End Function

在这一行出现运行时 438 错误：

Msc = SrcWbk.Cells(2, 13).Text

脚本必须从源工作簿单元格 2,13 中获取文本参数，然后从数组中获取此文本的编号。然后脚本必须从目标工作簿单元格 3,4 获取文本参数并在源工作簿中搜索它。然后我可以复制一些数据。

Answer 1

这涵盖了大多数 cmets。我认为它应该可以工作，但您可能需要检查工作簿/工作表名称，因为我在所有情况下都不是很清楚。

并检查我的wiersz_nazw 位是否正确。

最初的 438 错误是因为 Cells 需要工作表父级，而不是工作簿父级。

Sub GetFileCopyData()

Dim Fname As String
Dim SrcWbk As Workbook
Dim DestWbk As Workbook
Dim miesiac() As Variant
Dim m_i As Variant, i As Long, wiersz_nazw As Variant
Dim Msc As String, nazw As String 'each one needs to be specified

miesiac = Array(styczen, luty, marzec, kwiecien, maj, czerwiec, lipiec, sierpien, wrzesien, pazdziernik, listopad, grudzien)

Set DestWbk = ThisWorkbook 'file containing code
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
If Fname = "False" Then Exit Sub
Set SrcWbk = Workbooks.Open(Fname)

Msc = SrcWbk.Worksheets(1).Cells(2, 13).Text
m_i = Application.Match(Msc, miesiac, 0)

If Not IsNumeric(m_i) Then m_i = -1
nazw = SrcWbk.Worksheets(1).Cells(3, 4).Text 'change workbook/sheet as necessary
wiersz_nazw = Application.Match("*" & nazw & "*", SrcWbk.Worksheets(1).Range("X1:X100"), 0)
If IsNumeric(wiersz_nazw) Then
    SrcWbk.Worksheets(1).Cells(wiersz_nazw, 2).Copy DestWbk.Worksheets(1).Cells(m_i + 7, 3) 'change sheets as necessary
End If

End Sub