Блог

У меня есть CSV-файл под названием HardwareMonitoring.csv, расположенный в маршруте D:GPU Информация

Мне нужно запустить макрос в моем файле Excel, чтобы извлечь некоторую информацию из файла CSV и поместить ее в лист Excel 1 следующим образом:

 LAST value of column B of CSV file should be placed in the cell G2 of the Excel file 
LAST value of column C of CSV file should be placed in the cell A2 of the Excel file 
LAST value of column D of CSV file should be placed in the cell B2 of the Excel file 
LAST value of column E of CSV file should be placed in the cell C2 of the Excel file 
LAST value of column F of CSV file should be placed in the cell D2 of the Excel file 
LAST value of column G of CSV file should be placed in the cell E2 of the Excel file 
LAST value of column H of CSV file should be placed in the cell F2 of the Excel file 
 

Обратите внимание: Строка последнего значения не всегда будет одной и той же строкой, она будет отличаться

Изображение последних строк CSV-файла

Изображение файла Excel, в котором будет выполняться макрос

Изображение того, как должен выглядеть Excel после запуска макроса

Если макрос обнаруживает значения в файле Excel, идея заключается в том, что он может переопределить значения с помощью новых значений

Извлечение из CSV

 Option Explicit

Sub UpdateRecent()
    
    ' Constants
    Const sFolderPath As String = "D:GPU Info"
    Const sfName As String = "HardwareMonitoring.csv"
    Const sCols As String = "B:H"
    Const dName As String = "Sheet1"
    Const dFirst As String = "A2"
    
    Application.ScreenUpdating = False
    
    ' Source
    
    ' Check for existence of file.
    Dim sFilePath As String: sFilePath = sFolderPath amp; sfName
    If Dir(sFilePath) = "" Then
        MsgBox "The file '" amp; sFilePath amp; "' does not exist."
        Exit Sub
    End If
    
    ' Close file if open.
    Dim swb As Workbook
    On Error Resume Next
    Set swb = Workbooks(sfName)
    On Error GoTo 0
    If Not swb Is Nothing Then
        swb.Close SaveChanges:=True
    End If
    
    ' Open file depending on the list separator. This works for me
    ' on my computers, but is not correct. You may need to use
    ' only one of those without the 'Select Case' or use 'OpenTextFile'
    ' illustrated in FaneDuru's solution.
    Select Case Application.International(xlListSeparator)
    Case ","
        Set swb = Workbooks.Open(Filename:=sFilePath)
    Case ";"
        Set swb = Workbooks.Open(Filename:=sFilePath, Local:=True)
    Case Else
        MsgBox "The list separator '" _
            amp; Application.International(xlListSeparator) amp; "' is not covered."
        Exit Sub
    End Select
    
    Dim sws As Worksheet: Set sws = swb.Worksheets(1)
    
    Dim sCell As Range
    Set sCell = sws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious)
    If sCell Is Nothing Then
        swb.Close SaveChanges:=False              
        MsgBox "The worksheet is empty."
        Exit Sub
    End If

    Dim sData As Variant: sData = sws.Columns(sCols).Rows(sCell.Row).Value
    
    swb.Close SaveChanges:=False
    
    ' Result
    
    Dim cCount As Long: cCount = UBound(sData, 2)
    Dim dData As Variant: ReDim dData(1 To 1, 1 To cCount)
    dData(1, cCount) = sData(1, 1)
    Dim c As Long
    For c = 2 To cCount
        dData(1, c - 1) = sData(1, c)
    Next c
    
    ' Destination
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Worksheets(dName)
    Dim dCell As Range: Set dCell = dws.Range(dFirst)
    
    dCell.Resize(, cCount).Value = dData
    'dwb.Save

    Application.ScreenUpdating = True

End Sub
 

Пожалуйста, попробуйте следующий код. Он не открывает файл csv в Excel. Предполагается, что разделителем csv является запятая ( » ,»), а разделителем строк является vbCrLf . Если нет, они должны быть изменены при отправке кода определенного сообщения. Он помещает результат обработки на активный лист, но легко адаптировать код для выбора необходимого:

 Private Sub ExtractFromCSV()
    Dim ws As Worksheet, strFile As String, sep As String, arrCSV, arrLast, i As Long, strProbl As String
                           
    Set ws = ActiveSheet 'you can use here the sheet you need (maybe "Sheet1")

    strFile = "D:GPU InfoHardwareMonitoring.csv"
    
    'Put the content of the csv file in an array (split by the line ending separator). If not vbCrLf, use the appropriate one:
    arrCSV = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(strFile, 1).ReadAll, vbCrLf)
      If UBound(arrCSV) = 0 Then MsgBox "The end line delimiter is not the chosen one (vbCrLf)...": Exit Sub
      
    sep = ","   'the csv file separator. Use here the correct one if not comma
    arrLast = Split(arrCSV(UBound(arrCSV)), sep) 'split the last array row, by csv separator (comma, Tab etc.)
      If UBound(arrLast) = 0 Then MsgBox "The csv delimiter is not the chosen one...": Exit Sub
      
      'Put the extracted values in their place on the sheet:
     ws.Range("A2:G2").value = Array(arrLast(2), arrLast(3), arrLast(4), arrLast(5), arrLast(1))
End Sub