Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

14249 / 76807

←次へ　｜　前へ→


	【68057】Re:データによってフォントの色を変えたい

不明 - 11/1/28(金) 8:38 -


	引用なし

	パスワード

列はA～C、D～F列として書きました。修正してください。
テストしていませんので、動かなければ手入れをしてください。
Dictionaryが不明なら、ネットで検索して学習してください。

Sub Sample()
　　Dim dic1 As Object, dic2 As Object
　　Dim s1 As String, s2 As String, s As String
　　Dim k As Long
　　Dim v As String
　　
　　Set dic1 = CreateObject("Scripting.Dictionary")
　　Set dic2 = CreateObject("Scripting.Dictionary")
　　
　　For k = 2 To Range("A1").End(xlDown).Row
　　　　s1 = Cells(k, 1).Value & vbTab & Cells(k, 2).Value
　　　　s2 = Cells(k, 3).Value
　　　　s = s1 & vbTab & s2
　　　　dic1(s) = Empty
　　　　dic2(s1) = s2
　　Next
　　
　　For k = 2 To Range("D1").End(xlDown).Row
　　　　s1 = Cells(k, 4).Value & vbTab & Cells(k, 5).Value
　　　　s2 = Cells(k, 6).Value
　　　　s = s1 & vbTab & s2
　　　　
　　　　If Not (IsEmpty(s2) Or s2 = "") Then
　　　　　　If dic1.Exists(s) Then
　　　　　　　 Cells(k, 6).Font.ColorIndex = 0 '黒
　　　　　　Else
　　　　　　　　If dic2.Exists(s1) Then
　　　　　　　　　　v = dic2(s1)
　　　　　　　　　　If v >= Cells(k, 6).Value Then
　　　　　　　　　　　　Cells(k, 6).Font.ColorIndex = 3 '赤
　　　　　　　　　　Else
　　　　　　　　　　　　Cells(k, 6).Font.ColorIndex = 41 '青
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　End If
　　　　Else
　　　　　　If dic2.Exists(s1) Then
　　　　　　　　Cells(k, 6).Value = dic2(s1)
　　　　　　End If
　　　　End If
　　Next
End Sub

0 hits

▼

【68052】データによってフォントの色を変えたい まさ 11/1/27(木) 21:16