Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
156 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
【79343】Re:ランダムな数字の入力方法
お礼  アエロリット  - 17/8/1(火) 22:33 -
引用なし
パスワード
   ご対応ありがとうございます。
大変参考になり、勉強になりました。
まずは、シートに当て込んで動作確認してみたいと思います。
・ツリー全体表示
【79342】VLOOKUPエラー回避
質問  ちゃぷ  - 17/8/1(火) 22:02 -
引用なし
パスワード
   下記のコードを使用していますが、G列に記載した数字が
参照先(消耗品)に無い場合、#N/Aとなり、困っています。
出来れば、参照先に無い場合、「該当なし」というメッセージと
キャンセル状態もしくは空欄のままとしたいのですが、
さっぱり上手くいきません。

ご教授の程、宜しくお願い致します。

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim rng As Range
　　Dim r　 As Range
　 Set rng = Intersect(Target, Range("$G$9:$G$600"))
　　If Not rng Is Nothing Then
　　Application.EnableEvents = False
　　　　For Each r In rng
　　　　　　If r.Value <> "" Then
　　　　　　　　r.Offset(, -2).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 2, False)
　　　　　　　　r.Offset(, -1).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 3, False)
　　　　　　　　r.Offset(, 1).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 4, False)
　　　　　　　　r.Offset(, 2).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 5, False)
　　　　　　　　r.Offset(, 3).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 6, False)
　　　　　　　　r.Offset(, 4).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 7, False)
　　　　　　　　r.Offset(, 6).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 8, False)
　　　　　　　　r.Offset(, 8).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 9, False)
　　　　　　　　r.Offset(, 12).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 10, False)
　　　　　　　　r.Offset(, 13).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 11, False)
　　　　　　Else
　　　　　　　　r.Offset(, -2).ClearContents
　　　　　　　　r.Offset(, -1).ClearContents
　　　　　　　　r.Offset(, 1).ClearContents
　　　　　　　　r.Offset(, 2).ClearContents
　　　　　　　　r.Offset(, 3).ClearContents
　　　　　　　　r.Offset(, 4).ClearContents
　　　　　　　　r.Offset(, 6).ClearContents
　　　　　　　　r.Offset(, 8).ClearContents
　　　　　　　　r.Offset(, 12).ClearContents
　　　　　　　　r.Offset(, 13).ClearContents
　　　　　　End If
　　　　Next
　　　　Application.EnableEvents = True
　　　　Set rng = Nothing
　　End If
End Sub
・ツリー全体表示
【79341】Re:ランダムな数字の入力方法
回答  γ  - 17/8/1(火) 6:16 -
引用なし
パスワード
   参考にして下さい。
端数処理やシートへのあてはめは、
そちらで対応してください。

Option Explicit

Dim higher　As Double
Dim center　As Double
Dim lower　 As Double

Function getRand(x As Double, y As Double) As Double
　　getRand = x + (y - x) * Rnd()
End Function

' 範囲内ならそのまま、範囲外なら補正してランダム値を返す
' opt=0:　センターまでの間のランダム値
' opt=1:　上下限値寄りのランダム値
' opt=0:　センター寄りのランダム値
Function getRandExt(x As Double, opt As Long) As Double
　　If x > higher Then
　　　　Select Case opt
　　　　Case 0: getRandExt = getRand(center, higher)
　　　　Case 1: getRandExt = getRand((center + higher) / 2, higher)
　　　　Case 2: getRandExt = getRand(center, (center + higher) / 2)
　　　　End Select
　　ElseIf x < lower Then
　　　　Select Case opt
　　　　Case 0: getRandExt = getRand(lower, center)
　　　　Case 1: getRandExt = getRand(lower, (lower + center) / 2)
　　　　Case 2: getRandExt = getRand((lower + center) / 2, center)
　　　　End Select
　　Else
　　　　getRandExt = x
　　End If
End Function

Sub test()
　　Dim ary(1 To 5) As Double
　　Dim k　As Long
　　
　　higher = 800.55555
　　center = 775.55555
　　lower = 750.55555

　　ary(1) = 810: ary(2) = 775: ary(3) = 815: ary(4) = 740: ary(5) = 750
　　
　　For k = 1 To 5
　　　　Debug.Print getRandExt(ary(k), 0)
　　Next

　　Debug.Print "----慎重に戻す---------------"
　　For k = 1 To 5
　　　　Debug.Print getRandExt(ary(k), 1)
　　Next

　　Debug.Print "----大胆に戻す---------------"
　　For k = 1 To 5
　　　　Debug.Print getRandExt(ary(k), 2)
　　Next
End Sub
・ツリー全体表示
【79340】Re:ランダムな数字の入力方法
発言  アエロリット  - 17/7/31(月) 23:29 -
引用なし
パスワード
   補足
1.　基準線には数値が入力されています。
（値はシートによって異なります）
+基準線の値:800.55555
センターラインの値:775.55555
-基準線の値:750.55555

2.現在のシート内容
日付：　7/1 7/2 7/3 7/4 7/5
データ：810 775 815 740 750

3.得たい結果は、異常値は7/1、7/3、7/4になります。
+基準線を越えた日付は7/1、7/3になります。
この場合は、+基準線とセンターラインの間の値（ランダム値）に修正したい。
-基準線を越えた日付は7/4になります。
この場合は、-基準線とセンターラインの間の値（ランダム値）に修正したい。
修正後
7/1 7/2 7/3 7/4 7/5
780 775 790 760 750

このような形でご理解頂けますでしょうか。
・ツリー全体表示
【79339】Re:ランダムな数字の入力方法
発言  γ  - 17/7/31(月) 23:04 -
引用なし
パスワード
   説明不足です。
+基準線とか、-基準線とかが何かが不明です。

　　　 AY　AZ　・・・・
11
12
13
のような形式で、具体例を示してください。

・現在のシート内容、
・得たい結果のシート内容
をそれぞれ、上の形式で説明してください。
そうすれば、コメントが付くと思います。
・ツリー全体表示
【79338】ランダムな数字の入力方法
質問  アエロリット  - 17/7/31(月) 20:59 -
引用なし
パスワード
   目的：推移図に入力してある、値が異常の場合、正常値に修正。

現状、下記に記入してある項目1〜2まではしましたが、値が異常の場合、正常値に修正の仕方がわかりません。
知恵をお借りできませんでしょうか。
よろしくお願いいたします。

処理内容:
1.アクティブシートに入力してあるA3の文字を取得
2.listシートに記入してある文字列から検索して、ワークブック（推移図）を開く。
3.ワークブック（推移図）を開く。
4.セルF32〜AI32(31日まである場合はAJ32、それ以降の列は空欄)まで日付が入力されています。
5.セルF33〜AI33(31日まである場合はAJ33、それ以降の列は空欄)までデータ（数字）が入っています。
6.基準線が3つ有ります。（基準線は、1.+基準線（AY11に入力してある)、2.-基準線（AY15に入力してある）、3.センターライン（+基準線と-基準線の間、（AY13に入力してある））　
7.+基準線を超えたら、+基準線とセンターラインの間にランダムな値に修正したい。
※可能なら、+基準線に寄ってるランダムな数字orセンターラインに寄ってるランダムな数字を選択できると有りがたい。
8.同様に-基準線を超えたら、-基準線とセンターラインの間にランダムな値に修正したい。
※可能なら、-基準線に寄ってるランダムな数字orセンターラインに寄ってるランダムな数字を選択できると有りがたい。
9.データ修正が終了したら、次のシートを同様に修正する
※データは、シートによって小数点5ケタまで使用しています。


Option Explicit
Sub error_correction()
Dim Target As String
Dim FilenameIn As Range
Dim FilenameOut As Range
Dim PathnameIn As String
Dim PathnameOut As String
Dim plus As Double
Dim minus As Long
Dim Cl As Long
Dim cal As Long


Cl = Cells(51, 13).Value


Target = Cells(3, 1).Value

Worksheets("list").Select
PathnameOut = Cells(13, 3).Value
Set FilenameIn = Range(Cells(3, 2), Cells(12, 2)).Find(Target, LookAt:=xlPart)
Set FilenameOut = FilenameIn.Offset(0, 1)
If FilenameIn.Offset(0, 2).Value <> "5F" Then
　　PathnameIn = Cells(13, 2).Value
　　PathnameOut = Cells(13, 3).Value
　　Else
　　　　PathnameIn = Cells(14, 2).Value
　　　　PathnameOut = Cells(14, 3).Value
End If
Workbooks.Open Filename:=PathnameOut & "\" & FilenameOut & ".xls"
plus = Cells(33, 14)

'下記以降の処理がわかりません。
Do
If plus >= Cells(11, 51).Value Then
　 Cells(33, 14).Value = plus - (Cells(11, 51) - Cells(13, 51))
　 If Cells(33, 14) >= Cells(11, 51) Then
　　　Cells
　 End If
　　
End If
Loop

Set FilenameIn = Nothing
Set FilenameOut = Nothing

End Sub
・ツリー全体表示
【79337】Re:フォルダ名一覧を古い順に取得
発言  γ  - 17/7/28(金) 23:41 -
引用なし
パスワード
   FileSystemObjectを使って下さい。
ht tp://officetanaka.net/excel/vba/filesystemobject/folder.htm

日付といっても何の日付ですか？3種類あります。

決められた順に取り出すのは難しいので、
日付と名前をワークシートにいったん取り出してから、
好みの順に従ってソートを掛けることをお薦めします。
・ツリー全体表示
【79336】Re:フォルダ名一覧を古い順に取得
発言  カリーニン  - 17/7/28(金) 23:35 -
引用なし
パスワード
   FileSystemObject
で検索してみてください。
サブフォルダ取得や日付(作成日時や更新日時)を取得するとこが出来ます。
・ツリー全体表示
【79335】フォルダ名一覧を古い順に取得
質問  Kan  - 17/7/28(金) 23:05 -
引用なし
パスワード
   指定した場所にある複数のフォルダ名の一覧を、日付の古い順に取得したいです。
取得したいのは、フォルダ名と日付。
よろしくお願いします。
・ツリー全体表示
【79334】Re:RANDBETWEENについて
発言  カリーニン  - 17/7/26(水) 0:20 -
引用なし
パスワード
   もう一つ方法があるのを忘れてました。

[B2:U21] = "=RANDBETWEEN(0, 1)"
・ツリー全体表示
【79333】Re:RANDBETWEENについて
お礼  あああああ  - 17/7/19(水) 23:22 -
引用なし
パスワード
   ご丁寧に説明していただきまして、ありがとうございました。
載せてくださったサイトを参考に勉強します。
・ツリー全体表示
【79332】Re:RANDBETWEENについて
発言  カリーニン  - 17/7/18(火) 23:51 -
引用なし
パスワード
   ↓も参考になると思います。

ht　tp://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_070_10.html

最初の

>Sheets("Sheet1").Range("B2:U21") = RandBetween(0, 1)

これは、Rangeオブジェクトのプロパティが省略されてますので、

Sheets("Sheet1").Range("B2:U21").Value = RandBetween(0, 1)

と同じことになります。Rangeオブジェクトのプロパティが省略されると、
デフォルトであるValueプロパティと判断されます。

今度は、右辺の

>RandBetween(0, 1)

は""で括られてないので、変数として宣言してない限り、エラーとなります。

式を埋め込む場合は

= "=式"

と代入してやります。
・ツリー全体表示
【79331】Re:RANDBETWEENについて
発言  カリーニン  - 17/7/18(火) 23:06 -
引用なし
パスワード
   式を残したくない場合は、↓のようにしてください。

With Worksheets("Sheet1").Range("B2:U21")
　.FormulaR1C1 = "=RandBetween(0, 1)"
　.Value = .Value
End With
・ツリー全体表示
【79330】Re:RANDBETWEENについて
発言  カリーニン  - 17/7/18(火) 22:57 -
引用なし
パスワード
   ワークシート関数を直接使う場合は↓のように書きます。

Sub test2()
Dim c As Range
Dim r As Range
Set r = Worksheets("Sheet1").Range("B2:U21")
For Each c In r
　c.Value = WorksheetFunction.RandBetween(0, 1)
Next c
Set r = Nothing
End Sub
・ツリー全体表示
【79329】Re:RANDBETWEENについて
発言  カリーニン  - 17/7/18(火) 22:44 -
引用なし
パスワード
   参考ＨＰです。

ht tp://excelwork.info/excel/funcrnd/
・ツリー全体表示
【79328】Re:RANDBETWEENについて
発言  カリーニン  - 17/7/18(火) 22:41 -
引用なし
パスワード
   まず、基本書やヘルプ、解説サイトで勉強することをお勧めします。
正直言って、書き方がめちゃくちゃです。

Worksheets("Sheet1").Range("B2:U21").FormulaR1C1 = "=RandBetween(0, 1)"

これは、数式を埋め込んでますが、VBAで直接乱数を発生させることも可能です。
・ツリー全体表示
【79327】RANDBETWEENについて
質問  あああああ  - 17/7/18(火) 22:27 -
引用なし
パスワード
   VBA初心者です。

早速お聞きしたいのですが、Sheet1のB2からU21の範囲でランダムに0か1の値を表示させたくて以下のように記述しました。

Sub Macro()
　　Sheets("Sheet1").Range("B2:U21") = RandBetween(0, 1)
End Sub

ですが、実行しようとするとコンパイルエラーが表示されてどこを直せばいいのか分かりません。
すみませんが回答のほどお待ちしております。
・ツリー全体表示
【79326】Re:指定したセルに貼り付け
発言  アリエス  - 17/7/15(土) 8:25 -
引用なし
パスワード
   ご指摘ありがとうございます。
丸投げに等しい質問に対して、恥ずかしく思っています。
現状、自力で作成しており、行き詰る点が出てくると思います。
その際にあらためて質問させて頂きたいと思います。
よろしくお願いします。
・ツリー全体表示
【79325】Re:指定したセルに貼り付け
発言  γ  - 17/7/15(土) 6:57 -
引用なし
パスワード
   こんにちは。

「質問者の方へのお願い」に下記のように書かれています。

●何をやったか書いてください
> おそらくあなたは、色々なことを試してできなかった末にここに質問を書くのでしょう。
> しかし回答者は、あなたが今まで何をやってきたか、何を知っていて何を
> 知らないかわかりません。
> 今まで試したこと、やろうと思ったけどやり方がわからなかったことなどを
> できるだけ詳しく書いてください。

●してはいけない質問について
> 困ったことは基本的にどんな質問をされてもかまわないのですが、その中でも
> 不適切な質問、というのがあります。以下のような質問は原則として
> しないでください。お願いします。
>　　　　　 （中略）
> 　・丸投げ
> 　　　「○○するにはどうすればいいか教えてください」といったような、
> 　　　コードを最初から最後まで教えてもらうことを期待するような質問

どこまで作られたか示して、詰まっているところを具体的に質問して下さい。
万一まったく一行も書けないなら、まずは基本テキストを学習することをお薦めします。

---------------
さて、つまっているのはどこですか？
あなたがどの程度学習されている方なのか、まったく分かりません。
こちらはサービスセンターではありません。
自分でてきているところまで示して、不明な点に絞って質問するようにしましょう。

コピーペイストする骨格のコードは書けているのですか？
日にちが規則的に並んでいるなら、33行 (5 + 日)列 のデータをコピーペイストすればいいのですか。

日という数字を指定する方法は、Inputboxのヘルプを真似すればよいことです。

複数あるということは、どのように入力するのですか？それを示さないと。
書込先のセルは、上から順に詰めていくのですか？
・ツリー全体表示
【79324】Re:指定したセルに貼り付け
発言  とおりすがり  - 17/7/14(金) 23:44 -
引用なし
パスワード
   参考です。

ht tp://www.vbalab.net/bbspolicy.html
・ツリー全体表示
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
156 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free