Excel VBA質問箱 IV

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

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


75773 / 76732 ←次へ | 前へ→

【5391】Re:セルの書式設定について教えて下さい。
回答  つん E-MAIL  - 03/5/9(金) 16:31 -

引用なし
パスワード
   澤田 淳 さん、こんにちは
> A列のセルのパターン色と文字色をB列のセルの値により指定したいのですが
>どうすればできるか教えて下さい。
>
>A1 B1にはタイトルが入っています。
>B列にはパターン色が書いてあります。
>A2のセルの「あ」のパターンを黄、文字色を緑
>A3のセルの「い」のパターンを青、文字色を黄
>と言う具合です。
>
>字    色
>あ    黄
>い    青
>う    黄
>え    黄
>お    黄
>
> それから、同様のデータが複数のシートに入っているのですが
>(各シートの行数はそれぞれ違います)1シートにまとめる方法も教えて下さい。
>
>字    色
>あ    黄
>い    青
>う    黄
>え    黄
>お    黄
>字    色
>か    青
>き    黄
>く    青
>字    色
>け    黄
>こ    青
> と、こんな具合です。
>宜しくお願いいたします。

こんな感じでしょうか?

'==============================================
Sub まとめ()

  Dim lngRow As Long
  Dim lngRow2 As Long
  Dim ws As Worksheet
  
  With Worksheets("Matome")
    For Each ws In ActiveWindow.SelectedSheets
      Call subSettei(ws, lngRow)
      lngRow2 = .Range("A65536").End(xlUp).Row
      
      ws.Range(ws.Cells(1, 1), ws.Cells(lngRow, 1)).Copy _
        Destination:=.Cells(lngRow2, 1)
  
    Next ws
  End With
  
End Sub


Private Sub subSettei(ByVal arg_ws As Worksheet, ByRef arg_lngRow As Long)

  Dim r As Range
  Dim lngRow As Long
  
  With arg_ws
    arg_lngRow = .Range("A65536").End(xlUp).Row
  
    For Each r In .Range(.Cells(2, 1), .Cells(arg_lngRow, 1))
      Select Case r.Offset(, 1).Value
        Case "黄"
          r.Interior.ColorIndex = 6
          r.Font.ColorIndex = 10
        Case "青"
          r.Interior.ColorIndex = 5
          r.Font.ColorIndex = 6
      End Select
    Next r
  End With

End Sub
'==============================================

Matomeというシートに、選択したシートを書式設定してからまとめています。
こちらで実行したところ、一応正しく動作してるんちゃうかな?と思いますが、
一度お試しください。

2 hits

【5386】セルの書式設定について教えて下さい。 澤田 淳 03/5/9(金) 15:16 質問
【5391】Re:セルの書式設定について教えて下さい。 つん 03/5/9(金) 16:31 回答

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