我如何提取合并的数据并将其放入不同的工作表中？

Posted 2023-02-15

我如何使用excel vba选择性地提取合并的数据（不从excel表中手动单击并复制，也没有明确列出要复制的数据范围。我想要的是某种方式，使得程序从F列到H列提取具有相同名称类型的整行，例如分别使用不同名称（John，Charlie）的Martin_1，Martin_2和Martin _3并将其复制并粘贴到新工作表中。

将提取的数据放入3个不同的表中，即索引1，索引2和索引3，如下所示

这是我尝试的代码：

dim i as integer
dim lastmartinrow as integer
dim c as string
dim j as integer
dim lastjohnrow as integer
dim b as string
dim k as integer
dim lastcharlierow as integer
dim a as string

for i = 1 to lastmartinrow
Set c = .Find("Martin_1","Martin_2",Martin_3" LookIn:=xlValues)
If c Is Nothing Then
'find the last row has the same "Martin_1","Martin_2","Martin_3") 
'copy the entire rows from 1 to lastmartinrow and paste it to a new worksheet("Index1").name
for j = lastmartinrow + 1 to lastjohnrow
Set b = .Find("John_1","John_2","John_3" LookIn:=xlValues)
If b Is Nothing Then
'find the last row has the same "John_1","John_2","John_3") 
'copy the entire rows from lastmartinrow + 1 to lastjohnrow and paste it to a new worksheet("Index2").name
for k = lastjohnrow + 1 to lastcharlierow
Set a = .Find("Charlie_1","Charlie_2",Charlie_3" LookIn:=xlValues)
If a Is Nothing Then
'find the last row has the same Charlie_1","Charlie_2",Charlie_3") 
'copy the entire rows from lastjohnrow + 1 to lastcharlierow and paste it to a new worksheet("Index3").name

更新后的代码错误因为以前我没有在崩溃时保存电子表格，所以这是我现在正在使用的新工作表。[！[在此处输入图片描述] [6]] [6]

答案

我创建了通用代码，它将F中存在的所有匹配值（John，Marin，Charlie等）复制到H列，并将其粘贴到Index3工作表中。它不会用单行均值复制与其他任何行都不匹配的值（紧随其后）。

Sub UpdateVal()
    Static count As Long
    Dim iRow As Long
    Dim aRow As Long
    Dim a As Long
    Dim b As Long
    Dim selectRange As Range
    j = 2
    iRow = 1
    LastLine = ActiveSheet.UsedRange.Rows.count
    While iRow < LastLine + 1
        a = iRow + 1
        b = iRow + 5 ' Max Group Size with Same name in F to H column
        count = 1
        If Cells(iRow, "F").Value = "Martin1" Then
            sheetname = "Index1"
        ElseIf Cells(iRow, "F").Value = "John1" Then
            sheetname = "Index2"
        Else
            sheetname = "Index3"
        End If
        For aRow = a To b
            If Cells(iRow, "F") = Cells(aRow, "F") And Cells(iRow, "G") = Cells(aRow, "G") And Cells(iRow, "H") = Cells(aRow, "H") Then
                count = count + 1
            Else
                Set selectRange = Range("A" & iRow & ":J" & aRow - 1)
                selectRange.Copy
                indexrowcount = Sheets(sheetname).UsedRange.Rows.count
                Sheets(sheetname).Range("A" & indexrowcount).PasteSpecial xlPasteAll
                iRow = iRow + count
                Exit For
           End If
        Next aRow
    Wend
End Sub