0

Dataという次のワークシートがあります。 ここに画像の説明を入力

同じワークブックに、Employee Databaseという別のワークシートがあります。 ここに画像の説明を入力

Excelで、「従業員の電子メールアドレス」が従業員データベースにない場合、データワークシートから「従業員の電子メールアドレス」と対応する「会社」および「会社のURL」セルを赤くするにはどうすればよいですか?

つまり、 Employee Databaseワークシートを次のよう にしようとしています。ここに画像の説明を入力

例を挙げただけですが、実際には、これを行うには 10,000 セル以上のデータがあります。私はこれを手動でやり始めましたが、永遠にかかることに気付きました。

Excelでこれを行うことができるマクロがあるかどうか知りたいです。

助けていただければ幸いです。上記のスクリーンショットのワークブックの例をここからダウンロードできます: http://www.mediafire.com/?dttztp66dvjkzn8

4

2 に答える 2

2

これは VBA がなくても実行できますが、Dataシートのデータを少し変更する必要があります。

Excel での「ピボット テーブル」または「小計」スタイルのデータ ストレージはお勧めしません。主キーを 1 つの列に 1回だけ入力し、次の主キーまでその横に関連データを入力します。

結合されたセルと同様に、後でデータを再編成するときにのみ問題が発生します。

これが私がしたことです：

欠落している電子メール アドレスをデータ シートに記入する

列Bのデータの最後まで、A2列全体でセルを強調表示します。したがって、セルに会社名があり、メールが からしかない場合は、 を強調表示する必要があります。これは、使用可能なデータの各行に電子メール アドレスを入力しているためです。AB2:B100A2:A98A2:A100

Editing » Find & Select » Go To Specialに移動し、 を選択BlanksしてクリックしますOK。

スペシャル、ブランクスへ

空白を選択した状態で、 (上矢印) と入力し、 += ↑を押します。列 A の空白のセルには、不足している電子メール アドレスが入力されます。列 A を強調表示し、値をコピーして貼り付けます。CtrlEnter

メールの動的な名前付き範囲を作成する

シートで、Employee Database「参照先」ボックスに次の式を使用して「Emails」という名前の範囲を作成します。

=OFFSET('Employee Database'!$C$1,1,0,COUNTA('Employee Database'!$C:$C)-1,1)

条件付き書式を追加する

DataシートでA2:C whatever(例: A2:C20000) を強調表示し、[ホーム] » [スタイル] » [条件付き書式] に移動して、次の式を使用します。

=ISNA(MATCH($A2,Emails,0))

希望する配色を選択し、 をクリックしますOK。これは、いくつかのサンプルデータを使用して私のコンピューターでどのように見えるかです。

ハイライト サンプル データが見つかりません

いくつかの小さな制約があります。

  • Dataシートの列 A を空白のままにすることはできなくなりました。
  • Employee Databaseシートのデータ行の間に空白行を入れることはできません。これは、ダイナミック レンジの仕組みによるものです。

利点

このアプローチの利点は、IMO では非常に大きいです。

  • 従業員データベース シートの行を追加または削除すると、強調表示が自動的に調整されます。例: d@gmail.com を追加して c@nbc.com を削除すると、Dataシートの書式設定がすぐに更新されます。

更新された従業員データベース

  • 既存のワークシート構造を変更する必要はありません (不足しているデータを埋めて範囲名を追加する以外は)。追加のワークシートは必要ありません。
  • ワークブックは VBA を使用しないままにすることができます (まだ VBA がない場合)。
于 2012-07-09T15:47:11.873 に答える
1

これはあなたがしようとしていることですか？これにより、出力を含む新しいシート「望ましい結果」が作成されます。これをモジュールに貼り付けます。

Option Explicit

Sub Sample()
    Dim wsData As Worksheet, wsDB As Worksheet, wsO As Worksheet
    Dim lRow As Long, i As Long
    Dim clrRng As Range

    Set wsData = Sheets("Data")
    Set wsDB = Sheets("Employee Database")
    Set wsO = Sheets.Add

    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Desired Result").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    With wsO
        .Name = "Desired Result"
        wsData.Cells.Copy .Cells

        lRow = .Range("B" & .Rows.Count).End(xlUp).Row

        For i = 2 To lRow
            If .Range("A" & i).Value = "" Then .Range("A" & i).Value = .Range("A" & i - 1).Value
        Next i

        For i = 1 To lRow
            If Application.WorksheetFunction.CountIf(wsDB.Columns(3), .Range("A" & i).Value) = 0 Then
                If clrRng Is Nothing Then
                    Set clrRng = .Rows(i)
                Else
                    Set clrRng = Union(clrRng, .Rows(i))
                End If
            End If
        Next i

        If Not clrRng Is Nothing Then clrRng.Interior.ColorIndex = 3

        For i = lRow To 2 Step -1
            If .Range("A" & i).Value = .Range("A" & i - 1).Value Then .Range("A" & i).ClearContents
        Next i
    End With
End Sub
于 2012-07-08T23:28:51.150 に答える