按标准将数据复制到Excel(copying data to excel by criteria)

按标准将数据复制到Excel(copying data to excel by criteria)

我有这个vba代码，它将物理内存数据复制到一个特定的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

I have this vba code ,which is copying Physical memory data to one specific excel sheet,It is working fine, But i want to make it generic,Whenever i will call this function i want to copy the data to different range

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

最满意答案

只需在sub中添加一个参数：

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子句。 
 
 （上面未经测试的代码，但它应该有用。） 
Just add a parameter to your sub:
 
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
 
Note: Since you're only using the destinationRange once, there's no need for a With clause here.
 
(Untested code above, but it should work.)