Kopieren von Daten nach Excel nach Kriterien

Question

Ich habe diesen VBA-Code, der physische Speicherdaten zu einem bestimmten Excel-Blatt kopiert, Es funktioniert gut, Aber ich möchte es generisch machen, Immer wenn ich diese Funktion aufrufen werde ich will kopieren Sie die Daten auf verschiedenen Bereich

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 

Answer 1

fügen Sie einfach einen Parameter zu Ihrem Unter:

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 

Hinweis: Da Sie nur die destinationRange einmal verwendet wird, gibt es keine Notwendigkeit für eine With Klausel hier.

(Ungeprüfte Code oben, aber es sollte funktionieren.)