0

私はこのデータを持っており、欠陥コードの連続した複数の発生を追跡しています。
連続欠陥コードとは、同じエリア、同一ラインに連続して現れる欠陥コードのことです。複数とは、同じ領域および線の下に
3 回以上 (連続的でなくても) 表示される欠陥コードです。

エリア ライン ロット番号 日付コード 説明
Assy Line1 LOT000000001 10/3/2013 13:31 5c 振動不良
Assy Line12 LOT000000002 2013/10/3 13:25 5g キー誤動作
Labl Line2 LOT000000003 10/3/2013 13:08 5a 無料
Dice Line1 LOT000000004 2013 年 10 月 3 日 13:03 5b システム障害
Dice Line2 LOT000000005 10/3/2013 13:09 3j ソフトウェア障害
Dice Line3 LOT000000006 2013/10/3 13:29 5d 表示なし
Circ Line1 LOT000000007 10/3/2013 13:25 3n ショート
Circ Line1 LOT000000008 10/3/2013 13:38 3n ショート
Circ Line10 LOT000000009 10/3/2013 13:26 3n ショート
Circ Line12 LOT000000010 10/3/2013 13:30 3n ショート
Circ Line2 LOT000000011 10/3/2013 13:02 3n ショート
Circ Line3 LOT000000012 10/3/2013 13:15 3n ショート
Circ Line7 LOT000000013 10/3/2013 13:24 3n ショート
Circ LineA LOT000000014 10/3/2013 13:10 3o オープン
Circ LineA LOT000000015 10/3/2013 13:14 3n ショート
Circ LineA LOT000000016 10/3/2013 13:46 3c 高解像度
Circ LineA LOT000000017 10/3/2013 13:47 3n ショート
Circ LineA LOT000000018 10/3/2013 13:50 3o オープン
Circ LineA LOT000000019 10/3/2013 13:51 3n ショート
Circ LineA LOT000000020 10/3/2013 13:55 3b 低解像度
OSTS Line1 LOT000000021 2013 年 10 月 3 日 13:48 3b 低解像度
OSTS Line1 LOT000000022 10/3/2013 13:50 3f トレースなし
OSTS Line11 LOT000000023 10/3/2013 13:06 3a 信号なし
OSTS Line2 LOT000000024 10/3/2013 13:24 3a 信号なし

この場合、私の予想される結果は次のようになります。

Circ Line1 LOT000000007 10/3/2013 13:25 3n ショート
Circ Line1 LOT000000008 10/3/2013 13:38 3n ショート

連続発生のため。

これは複数回出現する場合です。

Circ LineA LOT000000015 10/3/2013 13:14 3n ショート
Circ LineA LOT000000017 10/3/2013 13:47 3n ショート
Circ LineA LOT000000019 10/3/2013 13:51 3n ショート

したがって、元のデータはシート 1 にあり、結果を同じヘッダーでシート 2 に転送する必要があります。
私がしたことは、元のデータを配列に渡してから、それを反復処理することです。
私は欲しいものを手に入れていません。コードが長いので、わざわざ投稿しませんでした。

そして、私のコードをデバッグするよりも、新しいコードを作成する方が簡単だと思います。
どんな助けでも大歓迎です。前もって感謝します。
それでも質問がある場合は、すぐに解決してください。

4

2 に答える 2

1

式I2==A2&B2&G2
式J2=式 ==COUNTIF($I$2:$I$25,I2)
式K2==I2=I3
式L2==IF(OR(K2,J2>=3,K1),"Copy","Do not copy")

データをフィルター処理し、column L目的のシートにコピーします。

ここに画像の説明を入力

于 2013-10-08T06:48:46.133 に答える
1

これには数式を使用することにも賛成です。投稿のコメントで提供したスクリーンショットは、数式を使用して導出されたものです。ただし、VBAコードが必要だったので、ここにあります。

たとえば、シートは次のようになります

ここに画像の説明を入力

論理：

  1. Sheet1 の最後の行を検索
  2. 数式=A2&B2&D2&F2を列 H に挿入します。
  3. 数式=IF(H2=H3,"YES",IF(H2=H1,"YES",""))を列 I に挿入します

  4. =IF(AND(I2="",COUNTIF(H:H,H2)>2),"YES" & H2,"")式を列 J に挿入します。

    • これを達成するための目的

    ここに画像の説明を入力

  5. 次に、出力用のシートを 2 つ作成します。Consecutive連続レコードはシートに、複数レコードはシートMultipleに出力してみましょう

  6. Col IforをフィルタリングしてシートYesに移動するConsecutive
  7. Col JforをフィルタリングしてシートNon Blanksに移動するMultiple
  8. Multiple列 J に基づいてシート内のデータを並べ替える
  9. H:Jすべてのシートから列を削除

コード：

Option Explicit

Sub Sample()
    Dim ws As Worksheet, wsConsc As Worksheet, wsMulti As Worksheet
    Dim lRow As Long

    '~~> Change this to the releavnt sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    '~~> To create Consecutive and Multi sheets, delete existing ones if appl
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets("Consecutive").Delete
    ThisWorkbook.Sheets("Multi").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    '~~> Create new sheets for output
    Set wsConsc = ThisWorkbook.Sheets.Add: wsConsc.Name = "Consecutive"
    Set wsMulti = ThisWorkbook.Sheets.Add: wsMulti.Name = "Multi"

    With ws
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        .Columns("H:J").ClearContents

        .Range("H2:H" & lRow).Formula = "=A2&B2&D2&F2"
        .Range("I2:I" & lRow).Formula = "=IF(H2=H3,""YES"",IF(H2=H1,""YES"",""""))"
        .Range("J2:J" & lRow).Formula = "=IF(AND(I2="""",COUNTIF(H:H,H2)>2),""YES"" & H2,"""")"

        .Range("H2:J" & lRow).Value = .Range("H2:J" & lRow).Value

        .AutoFilterMode = False

        With .Range("I1:I" & lRow)
            .AutoFilter Field:=1, Criteria1:="=YES"
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            wsConsc.Rows(1)
        End With

        .AutoFilterMode = False

        With .Range("J1:J" & lRow)
            .AutoFilter Field:=1, Criteria1:="<>"
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            wsMulti.Rows(1)

            wsMulti.Columns("A:J").Sort Key1:=wsMulti.Range("J2"), Order1:=xlAscending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
        End With

        .AutoFilterMode = False

        .Columns("H:J").ClearContents
        wsConsc.Columns("H:J").ClearContents
        wsMulti.Columns("H:J").ClearContents
    End With
End Sub

出力：

ここに画像の説明を入力

于 2013-10-08T07:21:18.667 に答える