如何复制并找到最后 125 行？

Question

我有一项任务需要从复制到另一个工作簿的 excel 工作簿中获取最后 125 条数据。我希望用户从文件浏览器 select 存储数据的 excel 文件。数据将始终在 C17:C2051、F17:F2051 范围内并继续...

最后我想把两个公式放在这些范围之上。

有公式：

=AVARAGE(INDEX(C17:C2051;MATCH(MAX(C17:C2051);C17:C2051;1)):INDEX(C17:C2051;MAX(1;MATCH(MAX(C17:C2051);C17:C2051;1)-124)))
=STDEV(INDEX(C17:C2051;MATCH(MAX(C17:C2051);C17:C2051;1)):INDEX(C17:C2051;MAX(1;MATCH(MAX(C17:C2051);C17:C2051;1)-124)))

我写了一些代码，但现在它实际上什么也没做。

Sub Get_Data_From_File()

Dim FileToOpen As String
Dim File As Workbook

    FileToOpen = Application.GetOpenFilename("Excel files (*.xlsx), *.xlsx")
    

Dim LastRow As Long
Dim Last8Rows As Range

LastRow = File.Range("D" & File.Rows.Count).End(xlUp).Row

Set Last8Rows = File.Range("C" & LastRow - 7)
Last8Rows.Copy

End Sub

Answer 1

这应该让你开始：

Sub Get_Data_From_File()

    Const START_ROW As Long = 17
    Const NUM_ROWS As Long = 125
    
    Dim FileToOpen As String
    Dim wb As Workbook, ws As Worksheet, wsDest As Worksheet
    Dim LastRow As Long, FirstRow As Long
    Dim LastRows As Range
    
    FileToOpen = Application.GetOpenFilename("Excel files (*.xlsx), *.xlsx", _
                                            Title:="Select file to import from")
    If FileToOpen = False Then Exit Sub 'no file selected
    
    Set wsDest = ActiveSheet             'pasting here; or specfy some other sheet...
    Set wb = Workbooks.Open(FileToOpen, ReadOnly:=True)
    Set ws = wb.Worksheets("data")       'or whatever sheet you need
    
    LastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row 'find last row
    If LastRow < START_ROW Then LastRow = START_ROW
    
    FirstRow = IIf(LastRow - NUM_ROWS >= START_ROW, LastRow - NUM_ROWS, START_ROW) 'find first row
    
    'copy ranges
    ws.Range("C" & FirstRow & ":C" & LastRow).Copy wsDest.Cells(START_ROW, "C")
    ws.Range("F" & FirstRow & ":F" & LastRow).Copy wsDest.Cells(START_ROW, "F")

    'Add the formulas (note you need the US-format when using .Formula
    '   or you can use your local format with .FormulaLocal

    wb.Close False 'no save

End Sub

Answer 2

经过这么多天，终于可以用了。我修改了代码中的一些行，它正在完成这项工作。再次感谢！

这是我的解决方案：

Sub Get_Data_From_File()

    Const START_ROW As Long = 17
    Const NUM_ROWS As Long = 124
    
    Dim FileToOpen As String
    Dim wb As Workbook, ws As Worksheet, wsDest As Worksheet
    Dim LastRow As Long, FirstRow As Long
    Dim LastRows As Range
    
    FileToOpen = Application.GetOpenFilename("Excel files (*.xlsx), *.xlsx", _
                                            Title:="Select file to import from") 'no file selected
    
    Set wsDest = ActiveSheet             'pasting here; or specfy some other sheet...
    Set wb = Workbooks.Open(FileToOpen, ReadOnly:=True)
    Set ws = wb.Worksheets("SMI_650_Lxy")       'or whatever sheet you need
    
    LastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row 'find last row
    If LastRow < START_ROW Then LastRow = START_ROW
    
    FirstRow = IIf(LastRow - NUM_ROWS >= START_ROW, LastRow - NUM_ROWS, START_ROW) 'find first row
    
    Debug.Print "FirstRow" & vbTab & FirstRow 'test
    Debug.Print "LastRow" & vbTab & LastRow
    Debug.Print "START_ROW" & vbTab & START_ROW
    
    'copy ranges
    ws.Range("C" & FirstRow & ":C" & LastRow).Copy wsDest.Cells(START_ROW, "C")
    ws.Range("F" & FirstRow & ":F" & LastRow).Copy wsDest.Cells(START_ROW, "F")
    ws.Range("M" & FirstRow & ":M" & LastRow).Copy wsDest.Cells(START_ROW, "M") 'formula
    ws.Range("P" & FirstRow & ":P" & LastRow).Copy wsDest.Cells(START_ROW, "P")
    ws.Range("S" & FirstRow & ":S" & LastRow).Copy wsDest.Cells(START_ROW, "S")
    ws.Range("V" & FirstRow & ":V" & LastRow).Copy wsDest.Cells(START_ROW, "V")
    ws.Range("Y" & FirstRow & ":Y" & LastRow).Copy wsDest.Cells(START_ROW, "Y")
    ws.Range("AF" & FirstRow & ":AF" & LastRow).Copy wsDest.Cells(START_ROW, "AF") 'formula
    ws.Range("AM" & FirstRow & ":AM" & LastRow).Copy wsDest.Cells(START_ROW, "AM") 'formula
    ws.Range("AP" & FirstRow & ":AP" & LastRow).Copy wsDest.Cells(START_ROW, "AP")
    ws.Range("AS" & FirstRow & ":AS" & LastRow).Copy wsDest.Cells(START_ROW, "AS")
    ws.Range("AV" & FirstRow & ":AV" & LastRow).Copy wsDest.Cells(START_ROW, "AV")
    ws.Range("AY" & FirstRow & ":AY" & LastRow).Copy wsDest.Cells(START_ROW, "AY")
    ws.Range("BB" & FirstRow & ":BB" & LastRow).Copy wsDest.Cells(START_ROW, "BB")
    ws.Range("BE" & FirstRow & ":BE" & LastRow).Copy wsDest.Cells(START_ROW, "BE")
    ws.Range("BL" & FirstRow & ":BL" & LastRow).Copy wsDest.Cells(START_ROW, "BL") 'formula
    ws.Range("BS" & FirstRow & ":BS" & LastRow).Copy wsDest.Cells(START_ROW, "BS") 'formula
    ws.Range("BV" & FirstRow & ":BV" & LastRow).Copy wsDest.Cells(START_ROW, "BV")
    ws.Range("BZ" & FirstRow & ":BZ" & LastRow).Copy wsDest.Cells(START_ROW, "BZ")
    ws.Range("CD" & FirstRow & ":CD" & LastRow).Copy wsDest.Cells(START_ROW, "CD")
    ws.Range("CH" & FirstRow & ":CH" & LastRow).Copy wsDest.Cells(START_ROW, "CH")
    ws.Range("CK" & FirstRow & ":CK" & LastRow).Copy wsDest.Cells(START_ROW, "CK")
    ws.Range("CN" & FirstRow & ":CN" & LastRow).Copy wsDest.Cells(START_ROW, "CN")
    ws.Range("CQ" & FirstRow & ":CQ" & LastRow).Copy wsDest.Cells(START_ROW, "CQ")
    ws.Range("CT" & FirstRow & ":CT" & LastRow).Copy wsDest.Cells(START_ROW, "CT")
    ws.Range("CW" & FirstRow & ":CW" & LastRow).Copy wsDest.Cells(START_ROW, "CW")
    ws.Range("CZ" & FirstRow & ":CZ" & LastRow).Copy wsDest.Cells(START_ROW, "CZ")
    ws.Range("DC" & FirstRow & ":DC" & LastRow).Copy wsDest.Cells(START_ROW, "DC")
    ws.Range("DF" & FirstRow & ":DF" & LastRow).Copy wsDest.Cells(START_ROW, "DF")
    'Add the formulas (note you need the US-format when using .Formula
    '   or you can use your local format with .FormulaLocal

    wb.Close False 'no save

End Sub

如何复制并找到最后 125 行？

How to copy and find the last 125 row?

excel

vba

data-migration