0

行内のいずれかのフラグの値に応じて、1 行を 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 に答える