0

変数の状態に応じて、いくつかの行を挿入または削除する必要があります。

Sheet1 にはデータのリストがあります。フォーマットされたシート2を使用して、そのデータをコピーしたいので、シート2は単なるテンプレートであり、シート1はユーザーフォームのようです。

私のコードが for ループまでに行うことは、データのみを含むシート 1 の行数と、データを含むシート 2 の行数を取得することです。

ユーザーがシート1にさらにデータを追加すると、シート2のデータの最後にさらに行を挿入する必要があり、ユーザーがシート1のいくつかの行を削除すると、行はシート2から削除されます。

それぞれの行数を取得できるので、挿入または削除する行数を取得できますが、そこが行き詰まりました。正しい量の行を挿入/削除するにはどうすればよいですか。また、行の色を白とグレーの間で交互にしたかったのです。

シート2のすべての行を削除してから、交互の行の色を使用してシート1にある同じ量の行を挿入するのはアイデアかもしれないと思いましたが、条件付き書式でmodを使用することについて何かを見ました。

誰でも助けてもらえますか？

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim listRows As Integer, ganttRows As Integer, listRange As Range, ganttRange As Range
    Dim i As Integer


    Set listRange = Columns("B:B")
    Set ganttRange = Worksheets("Sheet2").Columns("B:B")

    listRows = Application.WorksheetFunction.CountA(listRange)
    ganttRows = Application.WorksheetFunction.CountA(ganttRange)

    Worksheets("Sheet2").Range("A1") = ganttRows - listRows

    For i = 1 To ganttRows - listRows
        'LastRowColA = Range("A65536").End(xlUp).Row


    Next i

    If Target.Row Mod 2 = 0 Then
        Target.EntireRow.Interior.ColorIndex = 20
    End If

End Sub
4

1 に答える 1

1

サンプルデータがなかったため、これはテストしませんでしたが、試してみてください。ニーズに合わせて、セル参照の一部を変更する必要がある場合があります。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim listRows As Integer, ganttRows As Integer, listRange As Range, ganttRange As Range
    Dim wks1 As Worksheet, wks2 As Worksheet

    Set wks1 = Worksheets("Sheet2")
    Set wks2 = Worksheets("Sheet1")

    Set listRange = Intersect(wks1.UsedRange, wks1.columns("B:B").EntireColumn)
    Set ganttRange = Intersect(wks2.UsedRange, wks2.columns("B:B").EntireColumn)

    listRows = listRange.Rows.count
    ganttRows = ganttRange.Rows.count

    If listRows > ganttRows Then 'sheet 1 has more rows, need to insert
        wks1.Range(wks1.Cells(listRows - (listRows - ganttRows), 1), wks1.Cells(listRows, 1)).EntireRow.Copy 
       wks2.Cells(ganttRows, 1).offset(1).PasteSpecial xlPasteValues
    ElseIf ganttRows > listRows 'sheet 2 has more rows need to delete
        wks2.Range(wks2.Cells(ganttRows, 1), wks2.Cells(ganttRows - (ganttRows - listRows), 1)).EntireRow.Delete
    End If

    Dim cel As Range
    'reset range because of updates
    Set ganttRange = Intersect(wks2.UsedRange, wks2.columns("B:B").EntireColumn)

    For Each cel In ganttRange
        If cel.Row Mod 2 = 0 Then cel.EntireRow.Interior.ColorIndex = 20
    Next

End Sub

アップデート

この行を読み直してください

If the user adds some more data to sheet1 then i need to insert some more rows at the end the data in sheet2 and if the user deletes some rows in sheet1 the rows are deleted from sheet2.

私の解決策は、ユーザーがワークシートの下部にある行を挿入/削除するかどうかに基づいています。ユーザーが中央の行を挿入/削除する場合は、sheet1からクリアされたsheet2に範囲全体をコピーすることをお勧めします。

于 2012-05-24T14:25:13.273 に答える