Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
348 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
【75460】Re:L列にデータが入ってたらI列に記入
発言  kanabun  - 14/4/4(金) 9:38 -
引用なし
パスワード
   ▼じん さん：

>マクロで読み込み、転記用シートにコピー
>転記用シートにコピーされたデータを本シートに転記していく感じです。
>L列は自動で転記されていきます。
>

別案です。
他のところからデータをコピーして貼り付けると、貼り付けたとき、
Changeイベントというのが発生します。この方法は、これを利用するもの
です。
以下のコードを シート見出し(シートタブ)を右クリックして出てくる
「コードの表示」メニューで表示されるコード・ウィンドウに貼り付けて
L列にデータ貼付けてみてください。

'// L列にデータが追加／更新／削除があったら自動実行する
Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim i As Long
　　Dim r As Range, c As Range
　　Dim sa As String
　　
　　Set r = Intersect(Target, Range("L:L"))
　　If r Is Nothing Then Exit Sub
　　
　　Application.EnableEvents = False 'イベントを一時的に無視
　　For Each c In r
　　　　If IsEmpty(c.Value) Then
　　　　　　c.Offset(, -3).ClearContents
　　　　Else
　　　　　　Select Case c.Value
　　　　　　　Case Is >= 501: sa = "501 - "
　　　　　　　Case Is >= 451: sa = "451 - 500"
　　　　　　　Case Is >= 401: sa = "401 - 450"
　　　　　　　Case Is >= 351: sa = "351 - 400"
　　　　　　　Case Is >= 301: sa = "301 - 350"
　　　　　　　Case Is >= 251: sa = "251 - 300"
　　　　　　　Case Is >= 201: sa = "201 - 250"
　　　　　　　Case Is >= 151: sa = "151 - 200"
　　　　　　　Case Is >= 101: sa = "101 - 150"
　　　　　　　Case Else:　　　sa = "　　- 100"
　　　　　　End Select
　　　　　　c.Offset(, -3).Value = sa
　　　　End If
　　Next
　　Application.EnableEvents = True 'イベント復活
End Sub
・ツリー全体表示
【75459】Re:L列にデータが入ってたらI列に記入
発言  kanabun  - 14/4/3(木) 19:19 -
引用なし
パスワード
   ▼じん さん：

>>2. いつ実行するのか（自動で実行するのか／ 手動で実行するのか も）
>このマクロ自体は転記用シートから本シートに転記し終わった後に起動させます。
>
>>3. マクロ実行後のシートレイアウト
>
>
>>例 マクロ実行前
>>　　　I列 　　　　　L列
>>1　　301〜350　　　350
>>2　　201〜250　　　230
>>3　　201〜250　　　210　←ここまで前回のデータが入っています。
>>4　　　　　　　　　240　←ここから今回転記したデータです。
>>5　　　　　　　　　300
>>6　　　　　　　　　100
>>7　　　　　　　　　250
>>
>Iが空白でL列に文字が入ってたらマクロを起動して
>>
>>例 マクロ実行前
>>　　　I列 　　　　　L列
>>1　　301〜350　　　350
>>2　　201〜250　　　230
>>3　　201〜250　　　210
>>4　　101〜150　　　120
>>5　　251〜300　　　300
>>6　　　 〜100　　　100
>>7　　201〜250　　　250

>このような感じです。
そういうことでしたか。となると、L列の処理を始める行は I列のデータの
最終行のつぎの行から、ということになりますね？

Sub 範囲セット()
　　Dim i As Long
　　Dim r1 As Range, r2 As Range
　　Dim v
　　
　　With ActiveSheet
　　　　Set r1 = .Cells(.Rows.Count, "I").End(xlUp).Offset(1)
　　　　Set r2 = .Cells(.Rows.Count, "L").End(xlUp)
　　　　v = Excel.Range(r1.Offset(, 3), r2).Value
　　　　ReDim sa(1 To UBound(v), 0) As String
　　　　For i = 1 To UBound(v)
　　　　　　If Not IsEmpty(v(i, 1)) Then
　　　　　　　　Select Case v(i, 1)
　　　　　　　　　Case Is >= 501: sa(i, 0) = "501 - "
　　　　　　　　　Case Is >= 451: sa(i, 0) = "451 - 500"
　　　　　　　　　Case Is >= 401: sa(i, 0) = "401 - 450"
　　　　　　　　　Case Is >= 351: sa(i, 0) = "351 - 400"
　　　　　　　　　Case Is >= 301: sa(i, 0) = "301 - 350"
　　　　　　　　　Case Is >= 251: sa(i, 0) = "251 - 300"
　　　　　　　　　Case Is >= 201: sa(i, 0) = "201 - 250"
　　　　　　　　　Case Is >= 151: sa(i, 0) = "151 - 200"
　　　　　　　　　Case Is >= 101: sa(i, 0) = "101 - 150"
　　　　　　　　　Case Else:　　　sa(i, 0) = "　　- 100"
　　　　　　　　End Select
　　　　　　End If
　　　　Next
　　　　
　　　　r1.Resize(UBound(v)).Value = sa
　　End With
End Sub

↑はI列にデータが入っていないばあいを考慮に入れていません。
・ツリー全体表示
【75458】Re:L列にデータが入ってたらI列に記入
質問  じん  - 14/4/3(木) 17:55 -
引用なし
パスワード
   ▼kanabun さん：
>▼じん さん：
>

>データを読み込むのは手動ですか？
>どこかにあるデータをL列にコピーするのですか？ そうすると、L列は
>データを呼び込む前は空白ですか？

マクロで読み込んでます。
マクロで読み込み、転記用シートにコピー
転記用シートにコピーされたデータを本シートに転記していく感じです。
L列は自動で転記されていきます。

>「I列が空欄の場所」という条件は初めて聴きました。
>すると、「データを読み込む」まえにも、L列、I列には データがあるという
>ことですか？

すいません。
そういうことです。


>情況がよく分かりませんので、
>1. マクロ実行前のシートレイアウトと、

>2. いつ実行するのか（自動で実行するのか／ 手動で実行するのか も）
このマクロ自体は転記用シートから本シートに転記し終わった後に起動させます。

>3. マクロ実行後のシートレイアウト


>例 マクロ実行前
>　　　I列 　　　　　L列
>1　　301〜350　　　350
>2　　201〜250　　　230
>3　　201〜250　　　210　←ここまで前回のデータが入っています。
>4　　　　　　　　　240　←ここから今回転記したデータです。
>5　　　　　　　　　300
>6　　　　　　　　　100
>7　　　　　　　　　250
>
Iが空白でL列に文字が入ってたらマクロを起動して
>
>例 マクロ実行前
>　　　I列 　　　　　L列
>1　　301〜350　　　350
>2　　201〜250　　　230
>3　　201〜250　　　210
>4　　101〜150　　　120
>5　　251〜300　　　300
>6　　　 〜100　　　100
>7　　201〜250　　　250


説明不足で申し訳ございません。
このような感じです。
・ツリー全体表示
【75457】Re:L列にデータが入ってたらI列に記入
発言  kanabun  - 14/4/3(木) 17:04 -
引用なし
パスワード
   訂正

下の
> 例 マクロ実行前

マクロ動作後、のまちがいでした。
・ツリー全体表示
【75456】Re:L列にデータが入ってたらI列に記入
発言  kanabun  - 14/4/3(木) 17:01 -
引用なし
パスワード
   ▼じん さん：

>データを読み込むとL列に
>350とか240とかの数値が入ります。
データを読み込むのは手動ですか？
どこかにあるデータをL列にコピーするのですか？ そうすると、L列は
データを呼び込む前は空白ですか？


>仮にL列に350と入ったらI列に"301〜350"を表示させたいのです。
>
L列に1セル以上変更があったら動作するようなマクロは ワークシートの
Changeイベントを捉えて動くマクロをつかえばいいです。

>L列に記入されててI列が空欄の場所に表示させたいのです。
「I列が空欄の場所」という条件は初めて聴きました。
すると、「データを読み込む」まえにも、L列、I列には データがあるという
ことですか？

>
>記入していただいたマクロでは反応しませんでした‥
上のマクロは セルの入力に反応して動くマクロではないので、実行したいときに
手動で「マクロの実行」させるか、ボタンに登録しておいてそのボタンをクリック
して実行するマクロです。

情況がよく分かりませんので、
1. マクロ実行前のシートレイアウトと、
2. いつ実行するのか（自動で実行するのか／ 手動で実行するのか も）
3. マクロ実行後のシートレイアウト
を教えてください。

例 マクロ実行前
　　　I列 　　　　　L列
1　　301〜350　　　350
2
3　　201〜250　　　210
4
5
6
7

↑こういう状態で、L4 に 120 と数値が入ったら、自動で
↓となるように、マクロを実行させたい。

例 マクロ実行前
　　　I列 　　　　　L列
1　　301〜350　　　350
2
3　　201〜250　　　210
4　　101〜150　　　120
5
6
7
・ツリー全体表示
【75455】Re:L列にデータが入ってたらI列に記入
質問  じん  - 14/4/3(木) 16:39 -
引用なし
パスワード
   データを読み込むとL列に
350とか240とかの数値が入ります。
仮にL列に350と入ったらI列に"301〜350"を表示させたいのです。

L列に記入されててI列が空欄の場所に表示させたいのです。

記入していただいたマクロでは反応しませんでした‥
・ツリー全体表示
【75454】Re:L列にデータが入ってたらI列に記入
発言  kanabun  - 14/4/3(木) 13:22 -
引用なし
パスワード
   ▼じん さん：

>そこで、仮にL列に360とはいっていたらI列には351-400という数字を入れたいのですが、なかなかうまくいきません。
>色々、調べてここまで書いたのですが、思った操作になりません。

具体的にどんなことが「思った操作」にならないのですか？

L列に連続してデータが入っているなら、
↓こう(配列内でI列用の文字列を作成)したほうが速いと思いますが。

Sub Try1()
　　Dim i As Long
　　Dim r As Range
　　Dim v
　　
　　With ActiveSheet
　　　　Set r = Range("L3", .Cells(.Rows.Count, "L").End(xlUp)) 'Ｌ列データ範囲
　　　　v = r.Value
　　　　ReDim sa(1 To UBound(v), 0) As String
　　　　For i = 1 To UBound(v)
　　　　　　If Not IsEmpty(v(i, 1)) Then
　　　　　　　　Select Case v(i, 1)
　　　　　　　　　Case Is >= 501: sa(i, 0) = "501 - "
　　　　　　　　　Case Is >= 451: sa(i, 0) = "451 - 500"
　　　　　　　　　Case Is >= 401: sa(i, 0) = "401 - 450"
　　　　　　　　　Case Is >= 351: sa(i, 0) = "351 - 400"
　　　　　　　　　Case Is >= 301: sa(i, 0) = "301 - 350"
　　　　　　　　　Case Is >= 251: sa(i, 0) = "251 - 300"
　　　　　　　　　Case Is >= 201: sa(i, 0) = "201 - 250"
　　　　　　　　　Case Is >= 151: sa(i, 0) = "151 - 200"
　　　　　　　　　Case Is >= 101: sa(i, 0) = "101 - 150"
　　　　　　　　　Case Else:　　　sa(i, 0) = "　　- 100"
　　　　　　　　End Select
　　　　　　End If
　　　　Next
　　　　
　　　　.Range("I3").Resize(UBound(v)).Value = sa
　　End With
End Sub
・ツリー全体表示
【75453】L列にデータが入ってたらI列に記入
質問  じん  - 14/4/3(木) 12:05 -
引用なし
パスワード
   質問させてください。
資料を読み込んで一つにまとめるというマクロを組んでいます。

資料が何枚もあるので次々と次のセルに記入していくことになります。
そこで、仮にL列に360とはいっていたらI列には351-400という数字を入れたいのですが、なかなかうまくいきません。
色々、調べてここまで書いたのですが、思った操作になりません。


Dim i As Integer
Dim intL As Variant

　
i = 3
　
Do
i = i + 1
intL = SH2.Cells(i, 12)
If intL = "" Then
Exit Do
End If

　　If intL >= 501 Then
　　　SH2.Cells(Rows.Count, 9).End(xlUp).Offset(1) = "501 -　　 "
　　　
　　ElseIf intL >= 451 Then
　　　SH2.Cells(Rows.Count, 9).End(xlUp).Offset(1) = "451 - 500"

　　ElseIf intL >= 401 Then
　　　SH2.Cells(Rows.Count, 9).End(xlUp).Offset(1) = "401 - 450"
　　　
　　ElseIf intL >= 351 Then
　　　SH2.Cells(Rows.Count, 9).End(xlUp).Offset(1) = "351 - 400"
　　　
　　ElseIf intL >= 301 Then
　　　SH2.Cells(Rows.Count, 9).End(xlUp).Offset(1) = "301 - 350"
　　　
　　ElseIf intL >= 251 Then
　　　SH2.Cells(Rows.Count, 9).End(xlUp).Offset(1) = "251 - 300"
　　　
　　ElseIf intL >= 201 Then
　　　SH2.Cells(Rows.Count, 9).End(xlUp).Offset(1) = "201 - 250"
　　　
　　ElseIf intL >= 151 Then
　　　SH2.Cells(Rows.Count, 9).End(xlUp).Offset(1) = "151 - 200"
　　　
　　ElseIf intL >= 100 Then
　　　SH2.Cells(Rows.Count, 9).End(xlUp).Offset(1) = "101 - 150"
　　
　　ElseIf intL <= 100 Then
　　　SH2.Cells(Rows.Count, 9).End(xlUp).Offset(1) = "　　 - 100"
　　　

End If
Loop While intL <> ""

ご教示願います。
・ツリー全体表示
【75452】Re:特定条件のファイルの、セルの値を取...
発言  γ  - 14/4/1(火) 22:49 -
引用なし
パスワード
   VBAをまったく知らないのでしたら、
まずはテキストで勉強しましょう。
それが遅いようで一番早いと思います。
・ツリー全体表示
【75451】Re:xlDiagonalUp の使用について
お礼  ﾄｷﾉﾊｼﾞﾒ  - 14/4/1(火) 20:47 -
引用なし
パスワード
   ▼banｔ さん：
>たとえば s+1 を 4-s にする。

ban t さん有難うございました。うまくいきました。
また宜しくおねがいいたします。
・ツリー全体表示
【75450】Re:xlDiagonalUp の使用について
回答  banｔ  - 14/4/1(火) 10:21 -
引用なし
パスワード
   たとえば s+1 を 4-s にする。
・ツリー全体表示
【75449】xlDiagonalUp の使用について
質問  トキノハジメ  - 14/3/31(月) 16:28 -
引用なし
パスワード
   いつもお世話に成ります
以下の使用は出来るのですが

Dim s As Integer

For S= 1 To 3

Cell(s+5, s+1),Boders(xlDiagonalDown),LineStyle = xlcotinuous

Next s

上記にて右下がりの罫線が右下がりに連続してひけるのですが

xlDiagonalup を使って右上がりの罫線を右上がりに連続しての

表示は出来ないでしょうか。

宜しくお願い致します。
・ツリー全体表示
【75448】Re:順序よく、エクセルから画像を取り出す
お礼  クリプ  - 14/3/31(月) 12:50 -
引用なし
パスワード
   ▼ちび坊主 さん：
>このコードは画像の上下（ZOrder）の順番を入れ替えているだけなので、
>保存、拡張子をzipに変更、解凍は手動で。
ありがとうございました！！！
シートにあるような順番で画像ファイルが作成されました！
どうも有難うございました、解決しました！！！
・ツリー全体表示
【75447】Re:順序よく、エクセルから画像を取り出す
回答  ちび坊主  - 14/3/31(月) 10:22 -
引用なし
パスワード
   このコードは画像の上下（ZOrder）の順番を入れ替えているだけなので、
保存、拡張子をzipに変更、解凍は手動で。
・ツリー全体表示
【75446】Re:順序よく、エクセルから画像を取り出す
回答  クリプ  - 14/3/31(月) 6:30 -
引用なし
パスワード
   ▼ちび坊主さん、御回答いただきありがとうございます。
年度末のバタバタのため、返信が遅くなり申し訳ございません。
今後は落ち着きますので、極端に返信が遅くなることはないと思います。
引き続き、御指導ください。

>昔作った、どこにでもあるSortで横位置にも対応してみた。
ありがとうございます。
当方VBA知識が乏しく、使い方がよくわかりません。
以下のようにしたのですが、
（表面上は）何の動作もしてないように見えます。。。
どうも、この方法↓は違うように思います。。。
・まず、写真アルバムブックを立ち上げる。
・Sub test02()とSub BubbleSort(ByRef Ary() As Variant, ByVal key As Long)を
標準モジュールに貼り付ける。
・Sub test02()をF5で実行させる。

すみません、使い方についても御指導ください。
・ツリー全体表示
【75445】特定条件のファイルの、セルの値を取り出...
質問  あーさん  - 14/3/30(日) 0:25 -
引用なし
パスワード
   VBAはまったく知らない素人ですが、どうしてもマクロで必要になってしまったのでお願いします。

1.特定のフォルダの中にファイルが複数あり、その中には何かの値がはいっています
<abc.xls>
　　A　　B　　C　　D
1　abc
2　あ　　　　 ○　 赤
3　い　　○　　　　赤
4　う　　○　　　　青

<dfg.xls>
　　A　　B　　C　　D
1　dfg
2　か　　　　　　　赤
3　き　　　　　　　赤
4　く　　○　　　　黄

<hij.xls>
　　A　　B　　C　　D
1　hij
2　さ　　　　 ○　 青
3　し　　○　 ○　 赤
4　す　　○　　　　青

2.D列が「赤」でなおかつB列orC列が"空白以外"の行がある時
　A1のセルに記載してあるファイル名を取り出します
　※例題としてB,C列に○を入れていますが、空白以外の場合は何でも条件に当てはまります

3.マクロを組み込んでいるファイルにとりだしたA1の値が記載されるようにします
　（この場合はabc.xlsとhij.xlsのA1の値だけを記載したい）
　特定のファイルのA1セルの値が知りたいだけなのでフォーマットはなんでもいいです

マクロの基礎もわかってないので、できればベタっと貼れば使えるようなものを伺いたいのですが
わかりやすいサイト等がありましたらそちらでもかまいません。
どうぞよろしくお願いします。
・ツリー全体表示
【75444】Re:［データがないときの処理］
発言  マナ  - 14/3/28(金) 19:21 -
引用なし
パスワード
   データは７行目から順番に入力されるのではないのですか。
Q7あるいは、R7にデータがない場合でも、
７行目以下にデータがあることもありますか。

＞最終行 = 登録.Cells(23, 17).End(xlUp).Row

は、データがある一番下の行という意味ではないのですか。

やっぱり、よくわかりませんが、こうですか？
If WorksheetFunction.COUNTBLANK(登録.Range("R7:V23")) > 0 Then
・ツリー全体表示
【75443】Re:［データがないときの処理］
質問  りんご  - 14/3/28(金) 13:05 -
引用なし
パスワード
   ありがとうございます。再質問になります。


作業範囲内登録シート（Ｒ７：Ｖ２３）にデータがなにもないときに、作業を実行しないようにしたいのです。作業範囲内セルに入力セル数がないとき　　

　　If WorksheetFunction.Couna(Range("r7:v23")) > 0 Then

としてもみましたが、うまくゆきません

　次ような式となっております。診断よろしくお願いします。

Sub 残菜まとめて登録()

　　Dim 登録 As Worksheet, 当月 As Worksheet
　　Dim 月 As Long, 日 As Long
　　Dim 縦 As Long, 最終行 As Long
　　Dim msg As Long
　　Dim 行 As Long
　
　　Set 登録 = Worksheets("登録")
　　月 = 登録.Cells(4, 18).Value
　　日 = 登録.Cells(4, 20).Value
　　
　 '最終行を取得（Q23から上方向に牽索）
　　最終行 = 登録.Cells(23, 17).End(xlUp).Row
　　
　　
　　'If 登録.Range(登録.Cells(7, 18), 登録.Cells(最終行, 22)).Value = "" Then


　　　　MsgBox "入力データがありません"
　　　　　
　　　　　Exit Sub
　　　 End If

　　
　　msg = MsgBox("入力内容を登録月" & 月 & "シートに転送します。" & vbCrLf & "よろしいですか？", vbOKCancel + vbExclamation, "入力内容の転送")
　　If msg <> vbOK Then MsgBox "操作を中断しました": Exit Sub
　
　　Set 当月 = Worksheets("登録月" & 月)
　　縦 = 7
　　Do Until 当月.Cells(縦, 20).Value = ""
　　　　縦 = 縦 + 1
　　Loop

　　If WorksheetFunction.CountIf(当月.Range(当月.Cells(7, 20), 当月.Cells(縦, 20)), 日) >= 1 Then
　　　　msg = MsgBox("この日付はすでに使用されています ", vbOKOnly + vbCritical)
　　　　If msg = vbOK Then Exit Sub
　　
　　End If
　　
　　Application.ScreenUpdating = False
　　Application.Calculation = xlCalculationManual
　　Application.DisplayAlerts = False


　　For 行 = 7 To 最終行
　　　　当月.Cells(縦, 20).Value = 日
　　　　当月.Cells(縦, 21).Resize(, 7).Value = 登録.Cells(行, 17).Resize(, 7).Value
　　　　縦 = 縦 + 1
　　Next
　
　　With 当月
　　　　.Range(.Cells(7, 20), .Cells(縦 - 1, 27)).Sort _
　　　　　　Key1:=.Cells(7, 20), _
　　　　　　Order1:=xlAscending, _
　　　　　　Header:=xlNo, _
　　　　　　Orientation:=xlTopToBottom
　　End With

　　With 登録
　　　 ' .Range(.Cells(5, 4), .Cells(10, 7)).ClearContents
　　　 ' .Range(.Cells(12, 4), .Cells(15, 7)).ClearContents
　　　 ' .Range(.Cells(17, 4), .Cells(24, 7)).ClearContents
　　　 ' .Range(.Cells(26, 4), .Cells(29, 7)).ClearContents
　　　 ' .Range(.Cells(5, 11), .Cells(12, 14)).ClearContents
　　　 ' .Range(.Cells(14, 11), .Cells(19, 14)).ClearContents
　　　 ' .Range(.Cells(21, 11), .Cells(26, 14)).ClearContents
　　　 '.Range(.Cells(7, 18), .Cells(23, 18)).ClearContents
　　　
　　　 .Range(.Cells(7, 18), .Cells(23, 23)).ClearContents
　　　
　　　
　　End With
　　MsgBox "データ転送が終了しました。", vbOKOnly + vbInformation, "終了"
　　Application.DisplayAlerts = True
　　Application.Calculation = xlCalculationAutomatic
　　Application.Calculate
　　Application.ScreenUpdating = True
End Sub
・ツリー全体表示
【75442】Re:［無題］
発言  マナ  - 14/3/27(木) 21:02 -
引用なし
パスワード
   ▼りんご さん：
>>追加の質問ですが、以前にご指導いただいたマクロですが、入力項目（R7:Ｖ23）に値がないときに処理を中断するつもりで、式を張付ましたがうまくいきません。　このやり方は何が問題なのでしょうか？
>理解できていないのでよろしくお願いします。
>
>Sub 残菜まとめて登録()
>
>　　Dim 登録 As Worksheet, 当月 As Worksheet
>　　Dim 月 As Long, 日 As Long
>　　Dim 縦 As Long, 最終行 As Long
>　　Dim msg As Long
>　　Dim 行 As Long
>　
>　　Set 登録 = Worksheets("登録")
>　　月 = 登録.Cells(4, 18).Value
>　　日 = 登録.Cells(4, 20).Value
>　　
>　　　 If WorksheetFunction.CountBlank(Range("R7:Ｖ23")) > 0 Then
>　　　　　MsgBox "登録データがありません"
>　　　　　Exit Sub
>　　　 End If
>
>　　
>　　msg = MsgBox("入力内容を登録月" & 月 & "シートに転送します。" & vbCrLf & "よろしいですか？", vbOKCancel + vbExclamation, "入力内容の転送")
>　　If msg <> vbOK Then MsgBox "操作を中断しました": Exit Sub
>　
>　　Set 当月 = Worksheets("登録月" & 月)
>　　縦 = 7
>　　Do Until 当月.Cells(縦, 20).Value = ""
>　　　　縦 = 縦 + 1
>　　Loop
>
>　　If WorksheetFunction.CountIf(当月.Range(当月.Cells(7, 20), 当月.Cells(縦, 20)), 日) >= 1 Then
>　　　　msg = MsgBox("この日付はすでに使用されています ", vbOKOnly + vbCritical)
>　　　　If msg = vbOK Then Exit Sub
>　　
>　　End If
>　　　　　　(以下　略）


そちらのデータ配置がどんなものか、コードから推測しているだけなので
どう修正したらよいかも推測にばりますが、

If 登録.Cells(7,18).Value="" Then
とか
If 登録.Cells(7,17).Value="" Then
では、だめなのでしょうか？
・ツリー全体表示
【75441】Re:値の貼り付け方法（上位３位までのセ...
発言  マナ  - 14/3/27(木) 20:52 -
引用なし
パスワード
   ▼りんご さん：
>上位３位までの色付け完了しました。「条件付き書式を予め設定」の意味は
>参照の値を計算するよう当該セルに条件書式に設定するの意味でしょうか？

たぶん、それでよいと思います。
各列（N7:N31、O7:O31、P7:P31、Q7:Q31、R7:R31）に
条件付き書式を手操作で設定するということです。

計算式もI7:R31の範囲に手操作で入力してください。

データがない行は、計算結果を表示したくないなら、
例えば、こんな感じです。
I7には、=IF(B7="","",SUM(B7:H7))
K7には、=IF(B7="","",B7)

ただし、計算式が消えてはいけないので、
マクロでClearContentsするのは、B7:H31とします。


>>追加の質問ですが、以前にご指導いただいたマクロですが、入力項目（R7:Ｖ23）に値がないときに処理を中断するつもりで、式を張付ましたがうまくいきません。　このやり方は何が問題なのでしょうか？
>理解できていないのでよろしくお願いします。

もとのスレッドで返事します。
・ツリー全体表示
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
348 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free