excel - 如何使用 VBA 复制 Excel 工作表中的行并将其发送到 CSV？

Question

我想做的事情非常简单，我对 VBA 的经验几乎为零。不过，我有使用其他语言(java、js、c 等)进行编码的经验。

我想要做的是遍历 Excel 工作表的行，查看每行第一个单元格中的整数值是否在特定范围内，如果是，则复制整行并粘贴到一个新工作表中，该工作表将另存为 CSV。

我能够浏览该列并检查每行中的第一个单元格值，我现在需要知道如何获取相应的行、复制它并将其粘贴到 CSV 工作表中。

例如，假设这是我要解析的 Excel 工作表:

假设用户指定他们想要抓取该行第一个单元格中的值介于 3 和 9 之间的所有行(第 6-8、11、13-15 行)。然后，我的 VBA 代码将遍历所有行并仅抓取符合上述条件的行，然后将这些行发送到一个新工作表，如下所示:

这就是我的代码现在的样子，它沿着 A 列，并检查每行第一个单元格中的值。我不知道如何抓取每一行，然后将其发送到新工作表

Sub exportDesiredRowsToCSVSheet()

    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "myCSV"
    MsgBox "Sheet 'myCSV' was created"     'create new sheet that I will save as CSV at the end
    
    
    firstL = Application.InputBox("first line item num", "please enter num", , , , , , 1) 'gets user to input lower bound
    lastL = Application.InputBox("last line item num", "please enter num", , , , , , 1) 'gets user to input upper bound

    
    For Each Row In Range("A:A")        'go through rows in column A
        For Each Cell In Row            'go through first cell in each row of column A
            If Cell.Value >= firstL And Cell.Value <= lastL Then    'if the value in the cell is in the range
                'Here I want to take the desired rows and copy/paste them to a the newly created 'myCSV' sheet
                
            End If
        Next
    Next
        
    

End Sub

感谢任何帮助!

Answer 1

我怀疑您对 VBA 的了解远远超过了我对 Java 等的了解。以下基本代码将完成您想要的操作 - 遵循 @BigBen 关于查找最后一行并使用过滤器一次复制所有行的建议。

它假设代码位于该工作簿中。您需要为无效的用户输入添加自己的错误陷阱。

根据 OP 的要求编辑代码

Option Explicit
Sub CopyToCSV()
Dim LastRow As Long, FirstL As Integer, LastL As Integer

FirstL = InputBox("Pick the first Row number", "First Row Selection")
LastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

'EDIT - maximum number in range selected automatically
LastL = Application.WorksheetFunction.Max(Sheet1.Range("A2:A" & LastRow))

'Left in case you change your mind
'LastL = InputBox("Pick the final Row number", "Final Row Selection")

'***************************************************
'You'll need to determine your own Error Traps here
'***************************************************

With Sheet1
    .Range("A:A").AutoFilter Field:=1, Criteria1:=">=" & FirstL, _
    Operator:=xlAnd, Field:=1, Criteria2:="<=" & LastL
End With

'Create new sheet rather than new csv workbook
ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets _
(ThisWorkbook.Sheets.Count)).Name = "myCSV"

'Add new headers - change to suit
Sheets("myCSV").Cells(1).Resize(1, 5).Value = _
Array("NewH1", "NewH2", "NewH3", "NewH4", "NewH5")

'Copy to new sheet in this workbook assumes data is on sheet 1
'Copy values only (and formats?)
With Sheet1.Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
    .EntireRow.Copy
    Sheets("myCSV").Range("A2").PasteSpecial Paste:=xlPasteValues
    '*** UNCOMMENT THE NEXT LINE IF YOU ALSO WANT FORMATS COPIED ***
    'Sheets("myCSV").Range("A2").PasteSpecial Paste:=xlPasteFormats
End With

Application.CutCopyMode = False
Sheet1.AutoFilterMode = False

End Sub