Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6624 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【44128】チェックレポートの作成について 夜勤労働者 06/11/5(日) 9:56 質問[未読]
【44130】Re:チェックレポートの作成について ichinose 06/11/5(日) 10:09 発言[未読]
【44134】Re:チェックレポートの作成について 夜勤労働者 06/11/5(日) 13:02 質問[未読]
【44136】Re:チェックレポートの作成について Hirofumi 06/11/5(日) 18:03 回答[未読]
【44137】Re:チェックレポートの作成について ichinose 06/11/5(日) 20:29 発言[未読]
【44150】Re:チェックレポートの作成について 夜勤労働者 06/11/6(月) 14:06 質問[未読]
【44161】Re:チェックレポートの作成について ichinose 06/11/6(月) 21:31 発言[未読]
【44128】チェックレポートの作成について
質問  夜勤労働者  - 06/11/5(日) 9:56 -
引用なし
パスワード
   お早うございます。
　取り込まれたデータをチェックするめ、以下の計算式を使って、一応正常に動いて
います。　
　毎回チェック時に計算式の作成とシートの上から底まで結果チェック作業を省けたい
と思いますが、いい方法はあるのでしょうか？ご指導ください。

IF(MOD(C2,$B2)<>0,"×","○")

A　　B　　　　C　　 　D　 　　E　　　　C結果　　　Ｄ結果　　Ｅ結果
あ　 2　　　　4　 　　6　　　50 　　　　○　　　　○　　　　○
い　 3　　　　4 　　　6 　　 258　　　　×　　　　○　　　　○
う 　4　　　　12 　　16 　　 3　　　　　○　　　　○　　　　×
【44130】Re:チェックレポートの作成について
発言  ichinose  - 06/11/5(日) 10:09 -
引用なし
パスワード
   ▼夜勤労働者 さん：
おはようございます。

>　取り込まれたデータをチェックするめ、以下の計算式を使って、一応正常に動いて
>います。　
>　毎回チェック時に計算式の作成とシートの上から底まで結果チェック作業を省けたい
>と思いますが、いい方法はあるのでしょうか？ご指導ください。

ＶＢＡで一括で数式を設定する方法です。
>
>IF(MOD(C2,$B2)<>0,"×","○")
>
>A　　B　　　　C　　 　D　 　　E　　　　C結果　　　Ｄ結果　　Ｅ結果
>あ　 2　　　　4　 　　6　　　50 　　　　○　　　　○　　　　○
>い　 3　　　　4 　　　6 　　 258　　　　×　　　　○　　　　○
>う 　4　　　　12 　　16 　　 3　　　　　○　　　　○　　　　×

C結果、Ｄ結果、Ｅ結果という見出しがそれぞれセルＦ１、Ｇ１、Ｈ１だとすると

標準モジュールに

'===========================================================
Sub test()
　　Dim rng As Range
　　Set rng = Range("a2", Cells(Rows.Count, "a").End(xlUp))
　　If rng.Row > 1 Then
　　　 With rng.Offset(0, 5).Resize(, 3)
　　　　　 .Formula = "=if(mod(rc[-3],rc2)<>0,""×"",""○"")"
　　　　　 End With
　　　 End If
End Sub

として、当該シートをアクティブにした状態で
上記のtestを実行してみてください。

Ｆ列〜Ｈ列のデータが存在する行（Ａ列のデータで存在チェックをしています）に
数式が設定されます。
【44134】Re:チェックレポートの作成について
質問  夜勤労働者  - 06/11/5(日) 13:02 -
引用なし
パスワード
   ichinoseさん
返事ありがとうございます。
>C結果、Ｄ結果、Ｅ結果という見出しがそれぞれセルＦ１、Ｇ１、Ｈ１だとすると
[test]を動かしました。F2:H784（行数は可変のため）に正しい結果が表示されました。
本当に助かりました。

　チェック結果（F2:H784）をシートに置かせず、メッセージボックスに"×"の座標を
羅列することは、可能でしょうか？
【44136】Re:チェックレポートの作成について
回答  Hirofumi  - 06/11/5(日) 18:03 -
引用なし
パスワード
   こんなかな？
ただ、"×"の数が多いとMsgBoxで表示しきれるか疑問ですが？

Option Explicit

Public Sub Sample()

　　'データ列数（A列〜E列の5列）
　　Const clngColumns As Long = 5
　　'除数の有る列位置（基準セルからの列Offsetで指定）
　　Const clngDivisor = 1
　　
　　Dim i As Long
　　Dim j As Long
　　Dim lngRows As Long
　　Dim rngList As Range
　　Dim vntDivisor As Variant
　　Dim vntDividend As Variant
　　Dim strResult As String
　　Dim strProm As String
　　
　　'Listの左上隅セル位置を基準として設定(列見出しの最左セル位置)
　　Set rngList = ActiveSheet.Cells(1, "A")
　　With rngList
　　　　'データ行数を取得
　　　　lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
　　　　'データが無い場合
　　　　If lngRows <= 0 Then
　　　　　　strProm = "データが有りません"
　　　　　　GoTo Wayout
　　　　End If
　　　　'除数データを配列に取得
　　　　vntDivisor = .Offset(1, clngDivisor).Resize(lngRows + 1).Value
　　　　'被除数データを配列に取得
　　　　vntDividend = .Offset(1, clngDivisor + 1) _
　　　　　　　　　　　　.Resize(lngRows + 1, _
　　　　　　　　　　　　　　clngColumns - clngDivisor - 1).Value
　　End With
　　
　　'データ行全てに就いて繰り返し
　　For i = 1 To lngRows
　　　　'除数が0じゃ無い場合
　　　　If vntDivisor(i, 1) <> 0 Then
　　　　　　'被除数に就いて繰り返し
　　　　　　For j = 1 To clngColumns - clngDivisor - 1
　　　　　　　　'もし、剰余が有るなら
　　　　　　　　If vntDividend(i, j) Mod vntDivisor(i, 1) > 0 Then
　　　　　　　　　　'変数にセル位置を追加
　　　　　　　　　　If strResult <> "" Then
　　　　　　　　　　　　strResult = strResult & " "
　　　　　　　　　　End If
　　　　　　　　　　strResult = strResult & rngList.Offset(i, _
　　　　　　　　　　　　　　　　clngDivisor + j).Address(False, False)
　　　　　　　　End If
　　　　　　Next j
　　　　End If
　　Next i
　　
　　If strResult = "" Then
　　　　strProm = "×の該当無し"
　　Else
　　　　strProm = "×の該当 " & strResult
　　End If
　　
Wayout:
　　
　　Set rngList = Nothing
　　
　　MsgBox strProm, vbInformation
　　
End Sub
【44137】Re:チェックレポートの作成について
発言  ichinose  - 06/11/5(日) 20:29 -
引用なし
パスワード
   ▼夜勤労働者 さん：
こんばんは。


>　チェック結果（F2:H784）をシートに置かせず、メッセージボックスに"×"の座標を
>羅列することは、可能でしょうか？
できますけど、せっかく便利なセルを有効利用しなければ
宝の持ち腐れだと思いますけどね！！


'=================================================================
Sub test2()
　　Dim idx As Long, jdx As Long
　　Dim rng As Range
　　Dim add1 As String
　　Dim add2 As String
　　Dim ans As Variant
　　Dim mes As String
　　Set rng = Range("a2", Cells(Rows.Count, "a").End(xlUp))
　　If rng.Row > 1 Then
　　　 With rng
　　　　　 add1 = .Offset(0, 2).Resize(, 3).Address
　　　　　 add2 = .Offset(0, 1).Address
　　　　　 ans = Evaluate("=transpose(if(mod(" & add1 & "," & add2 & _
　　　　　　　　　　　　　 ")<>0,ADDRESS(ROW(" & add1 & "),COLUMN(" & add1 & ")),""""))")
　　　　　 End With
　　　 For idx = LBound(ans, 2) To UBound(ans, 2)
　　　　　 For jdx = LBound(ans, 1) To UBound(ans, 1)
　　　　　　　 If ans(jdx, idx) <> "" Then
　　　　　　　　　mes = mes & ans(jdx, idx) & vbCrLf
　　　　　　　　　End If
　　　　　　　 Next
　　　　　 Next
　　　 If mes <> "" Then MsgBox mes
　　　 End If
End Sub


敢えてするならこのようなコードでしょうか？
但し、Msgboxは表示文字数に制限があったと思いますから、
あまり表示するセル範囲が多いと全て表示されないことを制限事項とします。
【44150】Re:チェックレポートの作成について
質問  夜勤労働者  - 06/11/6(月) 14:06 -
引用なし
パスワード
   レイアウトの変更があって、修正はうまくいかず、止まってしまいました。
教えていただけませんか？
実施したいこと：
チェック範囲及び基準値を以下のように変更する場合は、
チェック範囲：C2:E760（３列）＝＝＝＞G5:K760（５列）へ変更
基準値：B2＝＝＝＞L5

修正結果：
Sub test02()
Dim idx As Long, jdx As Long
　　Dim rng As Range
　　Dim add1 As String
　　Dim add2 As String
　　Dim ans As Variant
　　Dim mes As String
　　Set rng = Range("a5", Cells(Rows.Count, "a").End(xlUp))　→2から5へ
　　If rng.Row > 1 Then
　　　 With rng
　　　　　 add1 = .Offset(0, 7).Resize(, 5).Address　　→2から7へ、２から５へ
　　　　　 add2 = .Offset(0, 1).Address
　　　　　 ans = Evaluate("=transpose(if(mod(" & add1 & "," & add2 & _
　　　　　　　　　　　　　 ")<>0,ADDRESS(ROW(" & add1 & "),COLUMN(" & add1 & ")),""""))")
　　　　　 End With
　　　　　 For idx = LBound(ans, 2) To UBound(ans, 2)
　　　　　　　For jdx = LBound(ans, 1) To UBound(ans, 1)
　　　　　　　　　If ans(jdx, idx) <> "" Then
　　　　　　　　　　 mes = mes & ans(jdx, idx) & vbCrLf
　　　　　　　　　End If
　　　　　　　Next
　　　　　 Next
　　　　　 If mes <> "" Then
　　　　　　　MsgBox mes, , "データのチェック"　　→タイトルを付けました
　　　　　 End If
　　 End If
End Sub

チェック範囲及び基準値を以下のように変更する場合は、
チェック範囲：C2:E760（３列）＝＝＝＞G5:K760（５列）へ変更
基準値：B2＝＝＝＞L5
【44161】Re:チェックレポートの作成について
発言  ichinose  - 06/11/6(月) 21:31 -
引用なし
パスワード
   ▼夜勤労働者 さん：
こんばんは。


>レイアウトの変更があって、修正はうまくいかず、止まってしまいました。
>教えていただけませんか？
これは、元のコードをじっくり時間をかけて解釈されて
ご自分で手直しされたほうが良いと思いますけどね！！

>実施したいこと：
>チェック範囲及び基準値を以下のように変更する場合は、
>チェック範囲：C2:E760（３列）＝＝＝＞G5:K760（５列）へ変更
>基準値：B2＝＝＝＞L5
>
>修正結果：
>Sub test02()
>Dim idx As Long, jdx As Long
>　　Dim rng As Range
>　　Dim add1 As String
>　　Dim add2 As String
>　　Dim ans As Variant
>　　Dim mes As String
>　　Set rng = Range("a5", Cells(Rows.Count, "a").End(xlUp))　→2から5へ
'　　　↑このコードがＡ列に入力されているデータを元に
'　　　 入力されているデータ範囲を取得しようとしていることが理解できないと
'　　　　応用が利きませんよ！！

　　If rng.Row > 4 Then
　　　'↑データの始まりが５行以上であることが処理を行うための最初のハードル
>　　　 With rng
　　　　　 add1 = .Offset(0, 6).Resize(, 5).Address
'　　　　　　↑Ｇ列〜Ｋ列なら上記のように修正、よく意味を考えてください
　　　　　 add2 = .Offset(0, 11).Address
'　　　　　　↑Ｌ列が除数の列なら上記になります。
>　　　　　 ans = Evaluate("=transpose(if(mod(" & add1 & "," & add2 & _
>　　　　　　　　　　　　　 ")<>0,ADDRESS(ROW(" & add1 & "),COLUMN(" & add1 & ")),""""))")
>　　　　　 End With
>　　　　　 For idx = LBound(ans, 2) To UBound(ans, 2)
>　　　　　　　For jdx = LBound(ans, 1) To UBound(ans, 1)
>　　　　　　　　　If ans(jdx, idx) <> "" Then
>　　　　　　　　　　 mes = mes & ans(jdx, idx) & vbCrLf
>　　　　　　　　　End If
>　　　　　　　Next
>　　　　　 Next
>　　　　　 If mes <> "" Then
>　　　　　　　MsgBox mes, , "データのチェック"　　→タイトルを付けました
>　　　　　 End If
>　　 End If
>End Sub
>
>チェック範囲及び基準値を以下のように変更する場合は、
>チェック範囲：C2:E760（３列）＝＝＝＞G5:K760（５列）へ変更
>基準値：B2＝＝＝＞L5

きちんと意味を理解されながら、修正してみてください
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6624 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free