Question

我需要将一行拆分为两行，具体取决于行中其中一个标志的值。结构如下： -

Exp_id  Flag_1 guar_percent
aaaa    Y   20
bbbb    N   0
cccc    Y   100
dddd    Y   90

在上述所有行中，所有将Flag_1设为'Y'且guar_percent＆gt; 0，＆lt; 100的行将被拆分为： - （我可以在拆分发生后填充guar_percent列）

Exp_id  Flag_1 guar_percent
aaaa_G  Y   100
aaaa_NG Y   0
dddd_G  Y   100
dddd_NG Y   0

由于

Answer 1

如果您将输入范围设置为数组并处理它应该是一个相对无痛的练习。以下代码经过全面评论，但如果没有意义，请告诉我。

Option Explicit

Sub SortData()
    Dim vInData As Variant, vOutData As Variant
    Dim ii As Long, lCounter As Long
    Dim wkOut As Worksheet

    'Read in your data, you could set this as a function and pass it any range
    vInData = ActiveSheet.Range("A1:C8").Value2

    'Double up the output array just in case every record is valid, we can redim after processing
    'Also not we've transposed the array because you can only redim preserve the second bound
    ReDim vOutData(LBound(vInData, 2) To UBound(vInData, 2), LBound(vInData, 1) To 2 * UBound(vInData, 1))

    'Loop through the input
    For ii = LBound(vInData, 1) To UBound(vInData, 1)
        'Check for the yes flag first
        If vInData(ii, 2) = "Y" Then
            'Then check the percentage bounds
            If vInData(ii, 3) > 0 And vInData(ii, 3) < 100 Then
                'Increase the counter by two since we're adding two lines.
                lCounter = lCounter + 2
                vOutData(1, lCounter - 1) = vInData(ii, 1) & "_G"
                vOutData(2, lCounter - 1) = "Y"
                vOutData(3, lCounter - 1) = 100
                vOutData(1, lCounter) = vInData(ii, 1) & "_NG"
                vOutData(2, lCounter) = "Y"
                vOutData(3, lCounter) = 0
            End If
        End If
    Next ii

    'Now we have all the outputs redim the array to remove empty elements
    ReDim Preserve vOutData(LBound(vOutData, 1) To UBound(vOutData, 1), LBound(vOutData, 2) To lCounter)

    'I've just dumped the output onto a fresh sheet, you can set the output array to any range on any worksheet you like
    Set wkOut = ThisWorkbook.Worksheets.Add
    With wkOut
        .Name = "Output"
        .Range(.Cells(1, 1), .Cells(UBound(vOutData, 2), UBound(vOutData, 1))).Value2 = Application.WorksheetFunction.Transpose(vOutData)
    End With
End Sub

Answer 2

这就是我所做的并且有效。欢迎任何优化它的建议。谢谢大家。

Sub SplitRec()
    Dim getRow As Long
    Dim LR As Long
    Dim RowCount As Integer

    For getRow = 1 To Worksheets("Sheet1").UsedRange.Rows.Count Step 1

         If (Worksheets("Sheet1").Cells(getRow, 111).Value) > 0 And (Worksheets("Sheet1").Cells(getRow, 111).Value) < 1 Then

            Worksheets("Sheet1").Rows(getRow).Copy Worksheets("Sheet2").Rows(Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 2).End(xlUp).Row + 1)
            Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Value = Worksheets("Sheet1").Range("A" & getRow).Value + "_G"

            Worksheets("Sheet1").Rows(getRow).Copy Worksheets("Sheet2").Rows(Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 2).End(xlUp).Row + 1)
            Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Value = Worksheets("Sheet1").Range("A" & getRow).Value + "_NG"

        Else
            RowCount = RowCount + 1

            Worksheets("Sheet1").Rows(getRow).Copy Worksheets("Sheet2").Rows(Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 2).End(xlUp).Row + 1)
            Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Value = Worksheets("Sheet1").Range("A" & getRow).Value

        End If
    Next

End Sub

在excel中将一行拆分为2行

2 个答案: