0

我需要根据行中一个标志的值将单行拆分为 2 行。结构如下：-

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

在上述所有行中，所有 Flag_1 为 'Y' 且 guar_percent >0、<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

谢谢

4

2 回答 2

0

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

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
于 2013-03-13T12:59:27.560 回答
0

如果您将输入范围设置为一个数组并处理它应该是一个相对轻松的练习。以下代码已被彻底注释，但如果没有意义，请告诉我。

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
于 2013-03-12T23:30:32.517 回答