3

互いに異なるハイライトセルに色を付けたいと思いました。この場合、colA と colB です。この関数は私が必要としているものには機能しますが、反復的で見苦しく、非効率的です。私は VBA コーディングに精通していません。この関数を記述するよりエレガントな方法はありますか?

編集 私がこの機能を実行させようとしているのは、次のとおりです。

    Sub compare_cols()

    Dim myRng As Range
    Dim lastCell As Long

    'Get the last row
    Dim lastRow As Integer
    lastRow = ActiveSheet.UsedRange.Rows.Count

    'Debug.Print "Last Row is " & lastRow

    Dim c As Range
    Dim d As Range

    Application.ScreenUpdating = False

    For Each c In Worksheets("Sheet1").Range("A2:A" & lastRow).Cells
        For Each d In Worksheets("Sheet1").Range("B2:B" & lastRow).Cells
            c.Interior.Color = vbRed
            If (InStr(1, d, c, 1) > 0) Then
                c.Interior.Color = vbWhite
                Exit For
            End If
        Next
    Next

    For Each c In Worksheets("Sheet1").Range("B2:B" & lastRow).Cells
        For Each d In Worksheets("Sheet1").Range("A2:A" & lastRow).Cells
            c.Interior.Color = vbRed
            If (InStr(1, d, c, 1) > 0) Then
                c.Interior.Color = vbWhite
                Exit For
            End If
        Next
    Next

Application.ScreenUpdating = True

End Sub
4

2 に答える 2

4

ああ、それはケーキです。私は一日中それをやっています。実際、あなたのコードは私がやろうとしている方法とほとんど同じです。ただし、「For Each」メソッドを使用するのではなく、整数のループを使用することを選択します。あなたのコードで見られる唯一の潜在的な問題は、ActiveSheet が常に "Sheet1" であるとは限らないことです。また、InStr は vbTextCompare パラメーターに関していくつかの問題を引き起こすことが知られています。指定されたコードを使用して、次のように変更します。

Sub compare_cols()

    'Get the last row
    Dim Report As Worksheet
    Dim i As Integer, j As Integer
    Dim lastRow As Integer

    Set Report = Excel.Worksheets("Sheet1") 'You could also use Excel.ActiveSheet _
                                            if you always want this to run on the current sheet.

    lastRow = Report.UsedRange.Rows.Count

    Application.ScreenUpdating = False

    For i = 2 To lastRow
        For j = 2 To lastRow
            If Report.Cells(i, 1).Value <> "" Then 'This will omit blank cells at the end (in the event that the column lengths are not equal.
                If InStr(1, Report.Cells(j, 2).Value, Report.Cells(i, 1).Value, vbTextCompare) > 0 Then
                    'You may notice in the above instr statement, I have used vbTextCompare instead of its numerical value, _
                    I find this much more reliable.
                    Report.Cells(i, 1).Interior.Color = RGB(255, 255, 255) 'White background
                    Report.Cells(i, 1).Font.Color = RGB(0, 0, 0) 'Black font color
                    Exit For
                Else
                    Report.Cells(i, 1).Interior.Color = RGB(156, 0, 6) 'Dark red background
                    Report.Cells(i, 1).Font.Color = RGB(255, 199, 206) 'Light red font color
                End If
            End If
        Next j
    Next i

    'Now I use the same code for the second column, and just switch the column numbers.
    For i = 2 To lastRow
        For j = 2 To lastRow
            If Report.Cells(i, 2).Value <> "" Then
                If InStr(1, Report.Cells(j, 1).Value, Report.Cells(i, 2).Value, vbTextCompare) > 0 Then
                    Report.Cells(i, 2).Interior.Color = RGB(255, 255, 255) 'White background
                    Report.Cells(i, 2).Font.Color = RGB(0, 0, 0) 'Black font color
                    Exit For
                Else
                    Report.Cells(i, 2).Interior.Color = RGB(156, 0, 6) 'Dark red background
                    Report.Cells(i, 2).Font.Color = RGB(255, 199, 206) 'Light red font color
                End If
            End If
        Next j
    Next i

Application.ScreenUpdating = True

End Sub

私が違うことをしたこと：

  1. 上記の整数メソッドを使用しました (「for each」メソッドとは対照的に)。
  2. ワークシートをオブジェクト変数として定義しました。
  3. InStr 関数では、数値の代わりに vbTextCompare を使用しました。
  4. 空白セルを省略するために if ステートメントを追加しました。ヒント: シート内の 1 つの列だけが非常に長い場合でも (たとえば、セル D5000 が誤って書式設定された場合)、すべての列の使用範囲は 5000 と見なされます。
  5. 色には RGB コードを使用しました (このキュービクルの隣の壁にチート シートがピン留めされているので、簡単です)。

それはそれについて要約します。あなたのプロジェクトで頑張ってください！

于 2013-01-11T15:22:51.790 に答える
1

'2 つの列を比較し、違いを強調表示します

    Sub CompareandHighlight()



        Dim n As Integer
        Dim valE As Double
        Dim valI As Double
        Dim i As Integer

        n = Worksheets("Indices").Range("E:E").Cells.SpecialCells(xlCellTypeConstants).Count
        Application.ScreenUpdating = False

        For i = 2 To n
        valE = Worksheets("Indices").Range("E" & i).Value
        valI = Worksheets("Indices").Range("I" & i).Value

            If valE = valI Then

            Else:

               Worksheets("Indices").Range("E" & i).Font.Color = RGB(255, 0, 0)

            End If
        Next i


    End Sub

' これがお役に立てば幸いです

于 2018-11-21T09:52:33.043 に答える