VBA ，提取表中某行A为DataName、B为Vd、C为 Vg、E列单元格为 Vb、F为 Id、G为 Ig、H为 Is、I为 Ib的下一行所有数据，存入新的表格。

您好，以下是 VBA 代码实现提取表中某行 A 为 DataName、B 为 Vd、C 为 Vg、E 列单元格为 Vb、F 为 Id、G 为 Ig、H 为 Is、I 为 Ib 的下一行所有数据并存入新的表格的代码：

Sub extractData()
    Dim originalSheet As Worksheet
    Dim newSheet As Worksheet
    Dim lastRow As Long
    Dim newRow As Long
    Dim dataName As String
    Dim vd As Double
    Dim vg As Double
    Dim vb As Double
    Dim id As Double
    Dim ig As Double
    Dim isCurrent As Double
    Dim ib As Double
    
    '选择原始表格
    Set originalSheet = ThisWorkbook.Sheets("原始表格")
    
    '获取最后一行
    lastRow = originalSheet.Cells(Rows.Count, "A").End(xlUp).Row
    
    '添加新表格
    Set newSheet = ThisWorkbook.Sheets.Add(After:=originalSheet)
    newSheet.Name = "提取数据"
    
    '设置新表格标题行
    newSheet.Cells(1, 1) = "DataName"
    newSheet.Cells(1, 2) = "Vd"
    newSheet.Cells(1, 3) = "Vg"
    newSheet.Cells(1, 4) = "Vb"
    newSheet.Cells(1, 5) = "Id"
    newSheet.Cells(1, 6) = "Ig"
    newSheet.Cells(1, 7) = "Is"
    newSheet.Cells(1, 8) = "Ib"
    
    '循环遍历原始表格
    For i = 2 To lastRow
        '获取当前行数据
        dataName = originalSheet.Cells(i, 1)
        vd = originalSheet.Cells(i, 2)
        vg = originalSheet.Cells(i, 3)
        vb = originalSheet.Cells(i, 5)
        id = originalSheet.Cells(i, 6)
        ig = originalSheet.Cells(i, 7)
        isCurrent = originalSheet.Cells(i, 8)
        ib = originalSheet.Cells(i, 9)
        
        '检查是否符合条件
        If dataName = "DataName" And vd = "Vd" And vg = "Vg" And vb = "Vb" And id = "Id" And ig = "Ig" And isCurrent = "Is" And ib = "Ib" Then
            newRow = 2 '设置新表格起始行
        ElseIf dataName <> "" And vd <> "" And vg <> "" And vb <> "" And id <> "" And ig <> "" And isCurrent <> "" And ib <> "" Then
            '添加新行到新表格
            newSheet.Cells(newRow, 1) = dataName
            newSheet.Cells(newRow, 2) = vd
            newSheet.Cells(newRow, 3) = vg
            newSheet.Cells(newRow, 4) = vb
            newSheet.Cells(newRow, 5) = id
            newSheet.Cells(newRow, 6) = ig
            newSheet.Cells(newRow, 7) = isCurrent
            newSheet.Cells(newRow, 8) = ib
            newRow = newRow + 1 '增加新表格行数
        End If
    Next i
End Sub

请将代码中的 "原始表格" 改为您实际的原始表格名称，然后在 VBA 中运行该代码即可。