excel - 通过检查单元格从一个工作簿复制到另一个工作簿
问题描述
我正在尝试将一些数据从一个工作簿复制到另一个工作簿,并检查 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 获取文本参数并在源工作簿中搜索它。然后我可以复制一些数据。
解决方案
这涵盖了大部分评论。我认为它应该可以工作,但是您可能必须检查工作簿/工作表名称,因为在所有情况下我都不是很清楚。
并检查我是否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
推荐阅读
- laravel - laravel 错误:rand() 期望参数 2 为 int, string
- python - SyntaxError:Python 关键字在 numexpr 查询中无效标识符
- android - Kotlin - 处理来自 EditText 的名称
- python - WebDriverException:消息:无效参数:无法终止退出的进程 Selenium python
- javascript - 如何根据选定的列表选项在页面加载时显示默认选项卡 (div)
- javascript - 如何让不和谐机器人为其自己的回复添加反应?
- sorting - 使用 dask 沿轴对数据集进行排序
- javascript - Typescript + webpack 输出空对象
- ffmpeg - 什么 ffmpeg 参数将近似缩放记录质量
- c++ - 当构造函数引发时,我应该/可以调用析构函数吗?可能在属性上?