Excel VBA質問箱 IV

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

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


1900 / 13645 ツリー ←次へ | 前へ→

【71122】エクセルで今日の日付文字から一定区間文字の色を変えたい ミコ 12/1/30(月) 20:35 質問[未読]
【71123】Re:エクセルで今日の日付文字から一定区間... ちん 12/1/31(火) 0:05 発言[未読]
【71136】大変参考になりましたっ! ミコ 12/1/31(火) 20:44 お礼[未読]

【71122】エクセルで今日の日付文字から一定区間文...
質問  ミコ  - 12/1/30(月) 20:35 -

引用なし
パスワード
   はじめまして、事務の仕事をしている、ミコと言います。
社内掲示板からエクセルに入れて、確認する仕事をして
いるんですが、こんなことができないかと思って質問し
ます。<(_ _)>

取り込んだエクセルは、E列に色々な簡易報告が書いて
あって、蓄積していくので過去のものからいっぱい書か
れています。(つぎ足し報告していく形です)

これが2〜30行くらいあって、どこに最新の書き込み
があるか簡単に分るようにしたいです。(・_・;)

ちょっとだけマクロを使ったりしているんですけど、や
りたいコトは、E2〜E30の間にある最近の書き込み
文字を赤くしたいってコトです。


・書き込みは必ず <yyyy/mm/dd〜 で始まる。
・ひとつ前の人も書き込み書き始めは <yyyy/mm/dd〜 
 だから、色変えの区切りはココまで。
・赤くしたいのは過去1週間の記述。
・同じE2に同じ週の書き込みは複数あります。
・下の例だと今日が2012/01/30なので後藤さん伊藤さん
 の書き込みが赤くて佐藤さんのはそのまま黒にしたいです。


┌─┬────────────────────┐
|1|         E列                  |
├─┼────────────────────┤
| |<2012/01/30 後藤>                 |
| |簡単報告文文文文文文文文文文文文文文文  |
| |文文文文文文文文文文文文文文文文文文文文|
| |文文文文文文文文文文文文文文文。      |
| |                               |
| |<2012/01/25 伊藤>                |
|2|簡単報告文文文文文文文文文文文文      |
| |文文文文文文文文文文文文文文文文文文文  |
| |文文文文文文文文文文。           |
| |                             |
| |<2012/01/15 佐藤>              |
| |簡単報告文文文文文文文文文文        |
| |文文文文文文文文文文文文文文文文文   |
| |文文文文文文文文文文文文文文文文文文。 |
| |                             |
| |                             |
├─┼────────────────────┤
|3|・・・・・・・・・・・・・・・                      |
├─┼────────────────────┤


私が考えていたのは

Mydata = Format(Date,"yyyy/mm/dd") &" "&Format(Date - 1,"yyyy/mm/dd") … -2 -3 -4- -5 -6

みたいに7日分の日付を求めて変数に格納
それを配列に入れて・・・
日付をInStrで検索して〜.Font.ColorIndex = 3 で赤くみたいにしたいんですけど
日付だけ赤くなったりで出来ません><;
こんなことってできますか?

これができれば他にもこんな更新の掲示板があるので
すっごく助かるので、よろしくお願いします。

【71123】Re:エクセルで今日の日付文字から一定区...
発言  ちん  - 12/1/31(火) 0:05 -

引用なし
パスワード
   ▼ミコ さん:こんばんわ、ちんといいます。
1週間ないの文を赤色にしたいですが。
とりあえず簡易的に作成しました。
文字列の位置から日付けを探し、判定する処理です。
1."<"を見つける。
2.1.でみつけた位置の後ろが必ず日付けになっているとして、日付けの判定
3.一週間以内の文のとき、赤色にする。です。

Sub test()
  Dim Start_Moji As Long
  Dim End_Moji As Long
  
  For i1 = 2 To Cells(2, 2).End(xlDown).Row
   Cells(i1, 2).Select
   Selection.Font.ColorIndex = 0
   
   For i2 = 1 To Len(Cells(i1, 2).Value)
    If Mid(Cells(i1, 2).Value, i2, 1) = "<" Then
     If IsDate(Mid(Cells(i1, 2).Value, i2 + 1, 10)) Then
      If Format(Mid(Cells(i1, 2).Value, i2 + 1, 10), "yyyy/mm/dd") >= Format(DateAdd("d", Date, -7), "yyyy/mm/dd") Then
       Start_Moji = i2
       For i3 = i2 + 1 To Len(Cells(i1, 2).Value)
        If Mid(Cells(i1, 2).Value, i3, 1) = "<" Then
         End_Moji = i3 - 1
         Exit For
        End If
       Next i3
       If i3 > Len(Cells(i1, 2).Value) Then
        End_Moji = i3 - 1
       End If
       '*** 赤色にセット
       With ActiveCell.Characters(Start:=Start_Moji, Length:=End_Moji - Start_Moji + 1).Font
        .ColorIndex = 3
       End With
       i2 = i3 - 1
      End If
       
     End If
    End If
   Next i2
  Next i1

End Sub


とりあえず、参考までに・・・

【71136】大変参考になりましたっ!
お礼  ミコ  - 12/1/31(火) 20:44 -

引用なし
パスワード
   ▼ちん さん:大変参考になりましたっ!

こんなに早く返信がいただけて助かりました。
ありがとうございます。
教えていただいたものを元に勝手ながら若干変更させて頂きました。

最下行を求める Cells(2, 2).End(xlDown).Row の部分については
伝え忘れていましたが、E列にも空白セルもあるので下から最大行を
取得するようにしました。
また、E列だったのでCells(*, 2)をCells(*, 5)に全部変えてみたら
見事に出来ましたっ!

これで応用も出来そうです。


------------------------
> Sub test()
>   Dim Start_Moji As Long
>   Dim End_Moji As Long
>   Dim maxRow As Range
   Dim maxRow_Temp
   maxRow_Temp = 50
   '*** とりあえずの最大最下行をmaxRow_Tempにいれる
  
   '*** For i1 = 2 To Cells(2, 2).End(xlDown).Row 元

   For i1 = 2 To Cells(maxRow_Temp, 5).End(xlUp).Row
                    '*** 下から最下行を取得する


  <省略>

1900 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free