[[20041214083035]] 『行又は列を指定の値に自動的に設定したい』(masabou5) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『行又は列を指定の値に自動的に設定したい』(masabou5)

条件付き書式から、条件に合ったセルの行又は列幅を指定の値に自動的に設定する方法はありませんか?VBAで処理するのでしょうか?
どなたかお教え下さい。


 条件付書式ではお望みのことは出来ないと思います。Excel2000
 仰るとおりVBAでの処理になると思います。
 (川野鮎太郎)

出来れば、そのVBAのソースをどのように作ったらいいか、教えていただけませんか?(masabou5)


 具体的な内容が判らないので、こちらを参考に頑張ってみてください。
http://www6.plala.or.jp/MilkHouse/menu.html
http://www.sanynet.ne.jp/~awa/excelvba/kouza.html

 (川野鮎太郎)

 明確に説明していただかないと、具体的な回答はできませんよ。
  (INA)

まことに申し訳ありませんでした。
 うまく説明できるか分かりませんが、次のようなことです。

月間カレンダーがあり、日曜日を検出したら、その日付の行の高さを20→10に変更したいのですが、可能でしょうか?(masabou5)


 その日付はどこのセルに入っているのでしょうか。
 行、列とも判りますか。
 (川野鮎太郎)

 お手数をおかけしています。
 説明がしにくいので、仮のサイトにアップしてみましたので、ご覧下さい。
 http://members.ytv.home.ne.jp/pandora5/yoteihyou

 オートカレンダーになっていて、条件付き書式で日曜日を検出しています。
 よろしくお願いします。(masabou5)


 こんなので用を足しますかね。
 Sub Test3()
 Dim MyRow As Long, i As Long
 Const MyHeight As Double = 6.25  '変更したい行高さ
 Const DefMyHei As Double = 13.5  '規定の行高さ
 Application.ScreenUpdating = False
    With ActiveSheet
        MyRow = .Range("A65536").End(xlUp).Row
        For i = MyRow To 3 Step -1
            If .Cells(i, 1).Value = "" Then
                .Cells(i, 1).EntireRow.RowHeight = DefMyHei
            Else
                Select Case Weekday(.Cells(i, 1).Value)
                    Case Is = 1
                        .Range(Cells(i, 1), Cells(i + 1, 1)).EntireRow.RowHeight = MyHeight
                    Case Else
                        .Cells(i, 1).EntireRow.RowHeight = DefMyHei
                    End Select
            End If
        Next i
    End With
 Application.ScreenUpdating = True
 End Sub

 (川野鮎太郎)


 C1セルを変えた時点で変更したい場合は、シートモジュールに入れてください。
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim MyRow As Long, i As Long
 Const MyHeight As Double = 6.25  '変更したい行高さ
 Const DefMyHei As Double = 13.5  '規定の行高さ
 If Target.Address(0, 0) <> "C1" Then Exit Sub
 Application.ScreenUpdating = False
    With ActiveSheet
        MyRow = .Range("A65536").End(xlUp).Row
        For i = MyRow To 3 Step -1
            If .Cells(i, 1).Value = "" Then
                .Cells(i, 1).EntireRow.RowHeight = DefMyHei
            Else
                Select Case Weekday(.Cells(i, 1).Value)
                    Case Is = 1
                        .Range(Cells(i, 1), Cells(i + 1, 1)).EntireRow.RowHeight = MyHeight
                    Case Else
                        .Cells(i, 1).EntireRow.RowHeight = DefMyHei
                    End Select
            End If
        Next i
    End With
 Application.ScreenUpdating = True
End Sub

 (川野鮎太郎)

 川野鮎太郎様、ありがとうございました。
 両方共に確認できました。
 すごいですね、こんなに短時間でここまで出来るとは、感激です。
 これからの作業がとても簡単になりました。
 心から御礼申し上げます。(masabou5)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.