0

私は小さなスクリプトに取り組んでいます(以下)。スクリプトは、データ セットの行を反復処理し、2 つの select case ステートメントのいくつかの条件に基づいて、セルに 1 または 0 を配置します。それは完璧に機能しますが、0が配置されているセルの範囲をグループ化する方法があるかどうかを知りたいです。

Sub compVal()

Dim WB As Workbook  'an object of type workbook
Dim WS1 As Worksheet ' objects of type worksheet

Set WB = ActiveWorkbook ' reference WB to the current Workbook
Set WS1 = Worksheets("Sheet1") 'Reference to Sheet 1 of the current workbook

'loop through sheet1's rows
Dim i As Integer

For i = 2 To WS1.UsedRange.Rows.Count

   Select Case WS1.Cells(i, 1).Value 'first cell from row i

      Case "Target"

         Select Case WS1.Cells(i, 2).Value

            Case 1

               WS1.Cells(i, 3).Value = 1
               WS1.Cells(i, 4).Value = 0
               WS1.Cells(i, 5).Value = 0
               WS1.Cells(i, 6).Value = 0

            Case 2

               WS1.Cells(i, 3).Value = 0
               WS1.Cells(i, 4).Value = 0
               WS1.Cells(i, 5).Value = 1
               WS1.Cells(i, 6).Value = 0

         End Select

      Case "NonTarget"

         Select Case WS1.Cells(i, 2).Value

            Case 1

               WS1.Cells(i, 3).Value = 0
               WS1.Cells(i, 4).Value = 1
               WS1.Cells(i, 5).Value = 0
               WS1.Cells(i, 6).Value = 0

            Case 2

               WS1.Cells(i, 3).Value = 0
               WS1.Cells(i, 4).Value = 0
               WS1.Cells(i, 5).Value = 0
               WS1.Cells(i, 6).Value = 1
         End Select

      End Select
Next i

サブ終了

4

1 に答える 1

1

これは、コードの再利用の良い例です。

Sub compVal()

Dim WB As Workbook  'an object of type workbook
Dim WS1 As Worksheet ' objects of type worksheet

Set WB = ActiveWorkbook ' reference WB to the current Workbook
Set WS1 = Worksheets("Sheet1") 'Reference to Sheet 1 of the current workbook

'loop through sheet1's rows
Dim i As Long ' USE LONG FOR CELL REFERENCES, THERE ARE A LOT OF ROWS POSSIBLE : )

For i = 2 To WS1.UsedRange.Rows.Count

   Select Case WS1.Cells(i, 1).Value 'first cell from row i

      Case "Target"

         Select Case WS1.Cells(i, 2).Value

            Case 1

               AddColumns WS1, i, 1, 0, 0, 0

            Case 2

               AddColumns WS1, i, 0, 0, 1, 0

         End Select

      Case "NonTarget"

         Select Case WS1.Cells(i, 2).Value

            Case 1

               AddColumns WS1, i, 0, 1, 0, 0

            Case 2

               AddColumns WS1, i, 0, 0, 0, 1

         End Select

      End Select
Next i
End Sub

Sub AddColumns(WS As Worksheet, i As Long, c As Variant, d As Variant, e As Variant, f As Variant)
    WS.Cells(i, 3).Resize(1, 4).Value = Array(c, d, e, f)

End Sub

4 つの引数 c、d、e、および f を単一の整数に置き換えるなど、他にも導入できる効率があります。

0  = 0,0,0,0
1  = 1,0,0,0
2  = 0,1,0,0
...
15 = 1,1,1,1
于 2013-02-07T08:24:41.623 に答える