且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

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

更新时间:2023-01-30 19:28:32

我创建了一个通用代码,它将所有F中存在的所有匹配值(John,Marin,Charlie等)复制到H列并将其粘贴到Index3中床单.它不会复制与其他任何行都不匹配的值(此后立即).

I have created a generic code, It will copy all the matching values(John,Marin,Charlie etc) present in F to H columns and paste it in Index3 sheet. It will not copy values with single row means which are not matching with any other row(immediately after that).

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 + 17 ' 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