vb调用excel两个sheet。

Posted 2023-04-23

我想完成这样的功能：从第一个sheet提取某单元格经过简单计算后写入第二个sheet中。例如：ExcelSheet2.cells(n, 2)=ExcelSheet1.cells(n, 1)+ExcelSheet.cells(n, 2)。下面的代码错在哪里呢？老提示在当前位置发现该文件，问是否替换。而我选是时，excel却并未改变。

Set objexcel1 = CreateObject("Excel.application")
Set objworkBook1 = objexcel1.Workbooks.Open("d:商品信息库.xls", 3, False)
Set ExcelSheet1 = objworkBook1.Worksheets(1)

objexcel1.Visible = False

Set objexcel2= CreateObject("Excel.application")
Set objworkBook2 = objexcel2.Workbooks.Open("d:商品信息库.xls", 3, False)
Set ExcelSheet2 = objworkBook2.Worksheets(2)

objexcel2.Visible = False

For n = 2 To 6

ExcelSheet2.cells(n, 6) = ExcelSheet2.cells(n, 6) + ExcelSheet1.cells(n, 3)
objworkBook2.save

Next n

objworkBook1.Close

objworkBook2.Close

你说的“excel却并未改变”是指修改后的数据没有保存吗？
提示出现是因为下一句：
objworkBook2.save
你用了两个workbook对象打开同一个文件，保存时冲突了。
修改后的代码：
Set objexcel1 = CreateObject("Excel.application")
Set objworkBook1 = objexcel1.Workbooks.Open("d:商品信息库.xls", 3, False)
Set ExcelSheet1 = objworkBook1.Worksheets(1)
Set ExcelSheet2 = objworkBook1.Worksheets(2)
objexcel1.Visible = False

For n = 2 To 6
ExcelSheet2.cells(n, 6) = ExcelSheet2.cells(n, 6) + ExcelSheet1.cells(n, 3)

Next n
objworkBook1.save
objworkBook1.Close
set objworkBook1=nothing
objexcel1.quit
set objexcel1=nothing

运行上述代码该Excel文件不能在打开状态。追问

非常感谢你，还有两个问题。1.你的代码最后3行是什么意思，不要程序也可运行吧？2.第二行“ Set objworkBook1 = objexcel1.Workbooks.Open("d:商品信息库.xls", 3, False)”中括号里文件名后的3和false是什么作用？

追答

objworkBook1.Close'关闭对应的Excel文件
set objworkBook1=nothing'销毁对象
objexcel1.quit'关闭Excel。如果没这句你会发现任务管理器里总有个Excel
set objexcel1=nothing'销毁对象

Set objworkBook1 = objexcel1.Workbooks.Open("d:商品信息库.xls", 3, False)
这句是抄你给的代码，通常我不加后面的参数，因为没研究过，第二个参数作用不明，第三个参数可指定是否以只读方式打开。可以在Open后面打入左括号根据提示来猜测（我就是这么干的^-^）。

参考资料：'

参考技术A 不会

excel vba数据比较？

如图，sheet1和sheet2中分别有两列数据，需要把sheet1中第一列的每个数据去sheet2中第1列中查找，找到相同的数据时，比较对应的第2列数据，第二列数据不同时在sheet1第3列中注明。

申明，我也才只学了几天，仅供参考- -所学不多，所以代码写的丑陋，练练手而已

在sheet1中插入代码：

---

Sub ZBT()

Dim i%, j%

    [c:c].Clear

For i = 2 To Range("a99999").End(3).Row

    j = Application.WorksheetFunction.CountIf(Worksheets("sheet2").[a:a], Cells(i, 1))

    If j = 0 Then

        Cells(i, 3) = "查无此序号"

    ElseIf j > 1 Then

        Cells(i, 3) = "有多项结果"

    ElseIf Cells(i, 2) <> Application.WorksheetFunction.VLookup(Cells(i, 1), Worksheets("sheet2").[a:b], 2, 0) Then

        Cells(i, 3) = "不同"

    End If

Next i

End Sub

参考技术A 一个公式就解决了，用不着Vba吧。c2=if(isblank(a2),"",iferror(if(vlookup(a2,sheet2!a:b,2,0)=b2,"","不相同"),"没得记录"))，公式下拉自动填充即可。追问

感谢回复，数据比较多，想要学习学习vba能不能快速处理