將數據複製到excel由條件

我有這個vba代碼，這是複製物理內存數據到一個特定的Excel表，它工作正常，但我想使它通用，每當我將調用此功能，我想將數據複製到不同的範圍將數據複製到excel由條件

Sub PhysicalMemWMI() 
Dim dTotalMemory   As Double 
Dim dAvailable   As Double 
Dim dFreeMem    As Double 

sWQL = "SELECT * FROM Win32_OperatingSystem" 
Set oWMISrvEx = GetObject("winmgmts:root/CIMV2") 
Set oWMIObjSet = oWMISrvEx.ExecQuery(sWQL) 

With ThisWorkbook.Sheets("Physical Memory") 


    For Each oWMIObjEx In oWMIObjSet 
     dTotalMemory = dTotalMemory + oWMIObjEx.TotalVisibleMemorySize 
    Next 
    dTotalMemory = dTotalMemory/1024 
    Set colItems = oWMISrvEx.ExecQuery("Select * from Win32_PerfFormattedData_PerfOS_Memory", , 48) 
    For Each objitem In colItems 
     dFreeMem = dFreeMem + objitem.FreeAndZeroPageListBytes 
     dAvailable = dAvailable + objitem.AvailableBytes 
    Next objitem 
    dFreeMem = dFreeMem/1024/1024 
    .Range("A2:B2").Value2 = Array(Format(((dTotalMemory * 1024 * 1024) - dAvailable)/1024/1024/1024, "#,##0.00 GB"), Format(dFreeMem, "#,##0 MB")) 
    End With 
End Sub

來源

2016-04-26 subhajit mondal

參數只需添加到您的子：

Option Explicit 

Sub test() 
    PhysicalMemWMI ActiveSheet.Range("A1") 
End Sub 

Sub PhysicalMemWMI(destinationRange As Range) 
    Dim dTotalMemory   As Double 
    Dim dAvailable   As Double 
    Dim dFreeMem    As Double 

    sWQL = "SELECT * FROM Win32_OperatingSystem" 
    Set oWMISrvEx = GetObject("winmgmts:root/CIMV2") 
    Set oWMIObjSet = oWMISrvEx.ExecQuery(sWQL) 

    For Each oWMIObjEx In oWMIObjSet 
     dTotalMemory = dTotalMemory + oWMIObjEx.TotalVisibleMemorySize 
    Next 
    dTotalMemory = dTotalMemory/1024 
    Set colItems = oWMISrvEx.ExecQuery("Select * " & _ 
         "from Win32_PerfFormattedData_PerfOS_Memory", , 48) 
    For Each objitem In colItems 
     dFreeMem = dFreeMem + objitem.FreeAndZeroPageListBytes 
     dAvailable = dAvailable + objitem.AvailableBytes 
    Next objitem 
    dFreeMem = dFreeMem/1024/1024 
    destinationRange.Value2 = Array(_ 
           Format(_ 
            ((dTotalMemory * 1024 * 1024) - dAvailable) _ 
            /1024/1024/1024, _ 
             "#,##0.00 GB"), Format(dFreeMem, "#,##0 MB")) 
End Sub

注：因爲你只使用了一次destinationRange，沒有必要對這裏With條款。

（以上未經測試的代碼，但它應該工作。）

來源

2016-04-26 20:20:55 PeterT

你的代碼只複製一個價值，但我複製這兩個值到一個特定的表（稱爲「物理內存」例如：我第一次想粘貼@ （A1：B1）...然後第二次我要粘貼數據@（C1：D1） –

如果你用'PhysicalMemWMI ActiveSheet.Range（「A1：B1」）''調用子程序，它會起作用嗎？我的代碼僅僅是一個例子，所以你可以隨意添加參數，例如定義要複製的值的數量，或者使用的字符串格式，或者類似的東西。希望這個例子能夠適應你的需求。 – PeterT

將數據複製到excel由條件

回答

相關問題