Question

我想问一下如何从vba代码

执行此操作

工作簿1包含单元格A，单元格B，单元格C. 练习册2包含单元格D. 每个单元格包含数字值细胞D =（细胞A-细胞B）*细胞C

我想计算并将值返回到工作簿2中的单元格D，这是我的代码片段

  Dim path As String
    Dim workbookName As String
    Dim worksheetName As String
    Dim cella As String, cellb As String, cellc As String
    Dim returnedValue1 As String, returnedValue2 As String, returnedValue3 As String
    Dim Hasil1 As Long

    path = "D:\"
    workbookName = "Workbook1"
    worksheetName = "Daily"

    cella = "F7"
    cellb = "E7"
    cellc = "D7"
    returnedValue1 = "'" & path & "[" & workbookName & "]" & _
          worksheetName & "'!" & Range(cella).Address(True, True, -4150)
    returnedValue2 = "'" & path & "[" & workbookName & "]" & _
          worksheetName & "'!" & Range(cellb).Address(True, True, -4150)
    returnedValue3 = "'" & path & "[" & workbookName & "]" & _
          worksheetName & "'!" & Range(cellc).Address(True, True, -4150)

    Worksheets("Workbook2").Cells(D).Value = CLng(ExecuteExcel4Macro(returnedValue1) - ExecuteExcel4Macro(returnedValue2)) * ExecuteExcel4Macro(returnedValue3)

到目前为止我的代码还不错，但如何在一列中完成，我在单元格A旁边有很多单元格。我想像这样计算 D列=（A栏 - B栏）* COlumn C

感谢您的回答..

Answer 1

类似的东西（A列中的行不为空，它在D列填充表达式）：

Sub mmacro()
    Dim path As String
    Dim workbookName As String
    Dim worksheetName As String
    Dim cella As String, cellb As String, cellc As String, celld As String

    Dim returnedValue1 As String, returnedValue2 As String, returnedValue3 As String
    Dim Hasil1 As Long
    Dim rownum As Integer
    Dim A As Integer, B As Integer, C As Integer, D As Integer

    path = "D:\tmp\"
    workbookName = "Book2"
    worksheetName = "Sheet1"

    cella = "F"
    cellb = "E"
    cellc = "D"

    celld = "A"

    rownum = 3'Data starts in row 3 in my example

    Do
        returnedValue1 = "'" & path & "[" & workbookName & "]" & _
              worksheetName & "'!" & Range(cella & rownum).Address(True, True, -4150)
        returnedValue2 = "'" & path & "[" & workbookName & "]" & _
              worksheetName & "'!" & Range(cellb & rownum).Address(True, True, -4150)
        returnedValue3 = "'" & path & "[" & workbookName & "]" & _
              worksheetName & "'!" & Range(cellc & rownum).Address(True, True, -4150)

        A = CInt(ExecuteExcel4Macro(returnedValue1))
        B = CInt(ExecuteExcel4Macro(returnedValue2))
        C = CInt(ExecuteExcel4Macro(returnedValue3))
        D = (A - B) * C

        Worksheets("Sheet1").Range(celld & rownum).Value = D
        rownum = rownum + 1
    Loop While Not D = 0
End Sub

这只是一个例子。需要进一步完善

Answer 2

此处我的评论还有一个更快的方法，不会使用循环。使用ACE.OLEDB将3列读入临时表，然后执行计算。是的，ACE.OLEDB将打开另一个excel文件，但它不像Excel那样打开它。

注意：以下代码使用早期绑定，请设置对ActiveX对象数据XX.XX库的引用。

Option Explicit

Sub Sample()
    Dim sConn As String
    Dim rs As ADODB.Recordset
    Dim mySQL As String, sPath As String
    Dim wsI As Worksheet, wsO As Worksheet
    Dim wsILRow As Long, i As Long

    '~~> Change this to the relevant Excel File
    sPath = "C:\MyFile.xlsx"

    '~~> Change connection string if the above is not xlsx
    sConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
               "Data Source=" & sPath & ";" & _
               "Extended Properties=Excel 12.0"

    '~~> Assuming that workbook 2 has sheet1 from where you want data
    mySQL = "SELECT * FROM [Sheet1$A:C]"

    Set rs = New ADODB.Recordset
    rs.Open mySQL, sConn, adOpenUnspecified, adLockUnspecified

    '~~> Create a temp sheeet to get the data from closed file
    Set wsI = ThisWorkbook.Sheets.Add
    '~~> Dump the data in the temp sheet
    wsI.Range("A1").CopyFromRecordset rs

    '~~> Close the recordset
    rs.Close
    sConn.Close
    Set rs = Nothing
    Set sConn = Nothing

    '~~> Get last row from temp sheet
    wsILRow = wsI.Range("A" & wsI.Rows.Count).End(xlUp).Row

    '~~> This is where you want the output
    Set wsO = ThisWorkbook.Sheets("Sheet1")

    With wsO
        '~~> Insert values in one go
        .Range("D1:D" & wsILRow).Formula = "=(" & wsI.Name & "!A1 - " & _
                                           wsI.Name & "!B1) * " & _
                                           wsI.Name & "!C1"
        '~~> Change formulas to values
        .Range("D1:D" & wsILRow).Value = .Range("D1:D" & wsILRow).Value
    End With

    '~~> Delete tmep sheet
    On Error Resume Next
    Application.DisplayAlerts = False
    wsI.Delete
    Application.DisplayAlerts = False
    On Error GoTo 0
End Sub

如何在没有打开文件的情况下从另一个工作簿中进行循环和计算公式

2 个答案: