通過檢查單元格從一個工作簿復制到另一個工作簿

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

這涵蓋了大部分評論。 我認為它應該可以工作，但是您可能需要檢查工作簿/工作表名稱，因為在所有情況下我都不是很清楚。

並檢查我的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