按标准将数据复制到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 SubI 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 SubNote: Since you're only using the destinationRange once, there's no need for a With clause here.
(Untested code above, but it should work.)
更多推荐
发布评论