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)

私のコードが良かった限りですが、1つの列でそれを行う方法は、セル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 に答える