Excel VBA質問箱 IV

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

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


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

【70668】文字列内のフォント変更 Characters 11/12/15(木) 16:09 質問[未読]
【70684】Re:文字列内のフォント変更 UO3 11/12/16(金) 12:27 回答[未読]

【70668】文字列内のフォント変更
質問  Characters  - 11/12/15(木) 16:09 -

引用なし
パスワード
   一つのセル内に改行されて文字列が多数入力されています。
「未入荷」の場合は入出庫Noを赤に。
「入荷」の場合は入出庫Noを青にしたいと考えています。

状況  入出庫No    名前
==================================
入荷  A111111  ああああああ
未入荷 A111112  いいいいい
入荷  A111113  うううううううう
完了  B111111  ええええええ
キャンセル  B111112  おおお
出荷  B111113  かかかかか
未入荷 C111111  きききき

↑の場合 
A111112とC111111が「赤」
A111111とA111113が「青」です。
これが一つのセル内に入っており、名前の最後に必ず改行が入ります。

「未入荷」の場合は下記マクロにて作成できたのですが、「入荷」の場合のでつまづいています。お知恵をお貸し頂けたらと思います。

chStr = "未"
Set myR = Cells(2, 11)
myStr = myR.Value
cutLen = 0
    
Do
  If Not InStr(myStr, chStr) > 0 Then Exit Do
   SrtPos = InStr(myStr, chStr)
   myR.Characters(Start:=SrtPos + 4 + cutLen,Length:=7).Font.ColorIndex = 3
   cutLen = cutLen + SrtPos + 13
   myStr = Mid(myStr, SrtPos + Len(chStr) + 13)
Loop

【70684】Re:文字列内のフォント変更
回答  UO3  - 11/12/16(金) 12:27 -

引用なし
パスワード
   ▼Characters さん:

こんにちは
文字列の区切りは全角スペース1文字という前提です。

Sub Test()
  Dim v As Variant
  Dim i As Long
  Dim myStr As String
  Dim myIndex As Long
  Dim f As Long
  Dim z As Long
  Dim l As Long
  
  With Range("K2")
    .Font.ColorIndex = xlAutomatic
    v = Split(.Value, vbLf)
    For i = LBound(v) To UBound(v)
      myIndex = 0
      If Left(v(i), 2) = "入荷" Then
        myIndex = 5
      ElseIf Left(v(i), 3) = "未入荷" Then
        myIndex = 3
      End If
      
      If myIndex > 0 Then
        f = InStr(v(i), " ") + 1
        l = InStr(f, v(i), " ") - f + 1
        .Characters(Start:=z + f, Length:=l).Font.ColorIndex = myIndex
      End If
      z = z + Len(v(i)) + 1
    Next
  End With
  
End Sub

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