0

我想问如何从 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

感谢您的回答..

4

2 回答 2

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

这只是一个例子。需要细化

于 2013-11-05T08:10:45.417 回答
1

除了我的评论之外，还有一种更快的方法，它不使用循环。使用 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
于 2013-11-05T08:40:41.770 回答