-1

私は時代遅れの CS の学位を取得しているため、VB の基本は理解していますが、マクロをあまり頻繁に作成することはなく、特定の状況を解決するための支援が必要です。(...しかし、関数とオブジェクト指向プログラミングは理解しています)

以下を想定してください: - 列 A には、アルファベット順にソートされた英数字形式の参照 ID が含まれています。- 列 B には、テキストの文字列または空白が含まれています。

列 B の「メモ」の内容に基づいて、一意の参照番号ごとに余分な行を自動的に削除するマクロを作成しようとしています。問題は、列 A に一意の参照番号のインスタンスが複数ある場合、どの行に列 B に何かが含まれているかを識別します。問題が 1 つあります。参照番号の列 B に何も含まれておらず、保持する必要がある可能性があります。

さらに説明するには、次のスクリーンショットで次のことを行う必要があります。

  • 黄色で強調表示された行を保持します
  • 残りの行を削除する

右側の赤でマークされた括弧を使用して、レポートがデータを表示する方法のさまざまな構成を示そうとしました。私がやろうとしていることを説明するのは難しいので、写真が必要なものをより明確に示すと考えました.

このタスクにより、レポートは非​​常に手作業で時間がかかります。

4

1 に答える 1

0

行を調べて、この行を削除する必要があるかどうか、この ID を持つ以前の行を削除する必要があるかどうか、または何も起こらないかどうかを確認するだけです。私の例では、これらの行をマークして最後に削除します。

Sub foo()
Dim rngSelection As Range
Dim startingRow As Integer
Dim endRow As Integer
Dim idColumn As Integer
Dim noteColumn As Integer
Dim idValuableRow As New Dictionary
Dim deleteRows As New Collection

Set rngSelection = Selection
startingRow = rngSelection.Row
endRow = rngSelection.Rows.Count + startingRow - 1


idColumn = rngSelection.Column
noteColumn = idColumn + 1

For i = startingRow To endRow
    currentID = Cells(i, idColumn)
    If idValuableRow.Exists(currentID) Then
        If Trim(idValuableRow(currentID)("note")) <> "" And Trim(Cells(i, noteColumn)) = "" Then
            deleteRows.Add i
         ElseIf idValuableRow(currentID)("note") = "" And Trim(Cells(i, noteColumn)) <> "" Then
            deleteRows.Add idValuableRow(currentID)("row")
            idValuableRow(currentID)("row") = i
            idValuableRow(currentID)("note") = Cells(i, noteColumn)
        End If
    Else
        Dim arr(2) As Variant
        idValuableRow.Add currentID, New Dictionary
        idValuableRow(currentID).Add "row", i
        idValuableRow(currentID).Add "note", Cells(i, noteColumn)
    End If


Next i
deletedRows = 0
For Each element In deleteRows
    If element <> "" Then
        Rows(element - deletedRows & ":" & element - deletedRows).Select
        Selection.Delete Shift:=xlUp
        deletedRows = deletedRows + 1

        End If
    Next element

End Sub

それはこのように見えるかもしれません。必要なのは、ツール/リファレンスに Microsoft Scripting Runtime を追加することだけです

于 2012-05-29T16:40:44.240 に答える