选择数据并复制的问题，等大师解惑。。。

homextt

Sub CopyRows()
    Dim ws As Worksheet
    Dim newWs As Worksheet

    '选择包含“研发费”和“借”的行的工作表
    Set ws = ThisWorkbook.Sheets("Sheet1") '更改为需要复制数据的表格所在的工作表名称
    Set newWs = ThisWorkbook.Sheets.Add '创建一个新的工作表

    '选择查找区域
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row '获取最后一行的行号
    Dim foundRange As Range
    Set foundRange = ws.Range("D:D & lastRow,H:H" & lastRow) '设置查找区域

    '循环查找符合条件的行，并将结果复制到新的工作表中
    Do While Not foundRange Is Nothing
        Dim rowNum As Long
        rowNum = foundRange.Row + 1 '获取当前行号
        If InStr(1, ws.Cells(rowNum, "B").Value, "借") > 0 And InStr(1, ws.Cells(rowNum, "C").Value, "研发费") > 0 Then
            ws.Rows(rowNum).Copy newWs.Rows(newWs.Rows.Count) '将符合条件的行复制到新的工作表中
        End If
       foundRange.Offset(0, 1).Resize(1, 8).ClearContents '清空查找区域中未匹配的数据
        foundRange.Offset(0, 1).Resize(1, 8).AutoFill (xlDown) '向下填充查找区域中的数据
        foundRange.Offset(0, 1).Resize(1, 8).SpecialCells(xlCellTypeConstants, 2)  '跳过表头和空单元格
    Loop

    MsgBox "已复制符合条件的行到新工作表中。" '提示复制完成
End Sub


自己感觉问题出在红字这部分，是这样的想选取附件里工作表的数据，条件是判断D列包含“研发费”同时H列为"借"，如果满足条件那么就复制这一行，到新生成的工作表去。另外请指点下Resize函数的用法谢谢，顺便指点下我整个表出错的地方（vba新手想上进），希望有大师能授予以渔。

homextt

自己先顶一个

吴中泉

homextt 发表于 2023-5-26 08:02
自己先顶一个

错的比较多啊

homextt

吴中泉 发表于 2023-5-26 08:39
错的比较多啊

哈哈哈略为尴尬

吴中泉

homextt 发表于 2023-5-26 08:02
自己先顶一个

用筛选复制即可,2秒搞定,不需要VBA

边缘码农

边缘码农

Set foundRange = ws.Range("D:D & lastRow,H:H" & lastRow) '设置查找区域

这一句这样改：

Set foundRange = ws.Range("D1:D" & lastRow &"," &"H1:H" & lastRow) '设置查找区域

边缘码农

  Do While Not foundRange Is Nothing
        Dim rowNum As Long    这个定义为什么放在循环里面？

这个do循环有没有避免死循环的手段？

边缘码农

EXCEL中的录制宏是个好工具，要善用。

homextt

吴中泉 发表于 2023-5-26 08:43
用筛选复制即可,2秒搞定,不需要VBA

老师我这个只是一个举了一个栗子，平时做数据比较多，可以类推在一堆数据里抓取我想要的