• ベストアンサー

VBA If~Thenの記述

御教示お願い致します。 ダイアログで売上表に入力する時(数量*単価=金額 計算時)、金額欄の処理を下記のように処理をしたく、試行錯誤しましたが完成出来ません。 得意先マスターのQ列に入力してある、端数処理のコード(1~3)によって処理をしたい 1:円未満四捨五入 2:円未満切捨て 3:円未満切り上げ Private Sub tannka_Change() '金額計算 Dim trg As Range Set trg = Workbooks("マスター.xls").Worksheets("得意先マスター") _ .Range("Q:Q").Find(what:=hasuu.Text, _ LookIn:=xlValues, lookat:=xlWhole) If trg = 1 Then kinngaku.Text = Round(CDec(suu.Text) * CDec(tannka.Text)) Else End If End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.6

こんにちは。 質問から読ませていただきましたが、#4/5さんのご指摘のように、それは、きちんとした説明がない限りは、サンプルコードとしては書けても、実務レベルの内容は難しいです。おまけに、どこかのテキストをみて、コントロール・オブジェクトの名称まで変えてしまっていますから、それを、#3さんのサンプルコードを書き換えて使うというには、それに技術が伴わないようです。 なお、あくまでも、コマンドボタンの使用を否定しているようにお見受けしています。したがって、私としては、KeyDown イベントを用いるしかないように思います。Change イベントでは、入力している最中にコードが働いてしまいます。 #3の補足のコードを参考にしてみました。 Private Sub tannka_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)   If KeyCode = 13 Then 'Enterキーによって実行     Dim r As Range     Dim i As Variant     Dim tanka As Currency, suji As Currency     Set r = Workbooks("マスター.xls").Worksheets("得意先マスター").Columns(4).Find( _       what:=tokukoudo.Text, _       LookIn:=xlValues, _       lookat:=xlWhole)       If r Is Nothing Then 'マスタが見つからないときの処理       MsgBox "得意先マスタに該当なし"       Exit Sub     Else       tanka = Val(tannka.Text)       suji = Val(suu.Text)     End If     i = Workbooks("マスター.xls").Worksheets("得意先マスター").Cells(r.Row, "Q").Value     Select Case i       Case Is = 1 'TextBox4が金額         kinngaku.Text = Format$(WorksheetFunction.Round(suji * tanka, 0), "#,##0")       Case Is = 2         kinngaku.Text = Format$(WorksheetFunction.RoundDown(suji * tanka, 0), "#,##0")       Case Is = 3         kinngaku.Text = Format$(WorksheetFunction.RoundUp(suji * tanka, 0), "#,##0")       Case Else         kinngaku.Text = "要検査"     End Select   End If End Sub

isekaoru
質問者

お礼

Wendy02様 要領の得ない質問に対し、問題点をご推察いただいての、御指導ありがとうございます。 思い通り出来ましたありがとうございました。 >それに技術が伴わないようです。 ●恥ずかしながら、ご指摘の通りです。 それ故に、要領を得ない質問内容となってしまいます。 >専門は、まったく違いますが、趣味だからこそ書けるものもあります。 ●私は、ボケ防止のため(68歳の無職)に勉強しております。 今回は自分で課題を作成して勉強しています。 最後は、まるなげしているような質問になってしまいますが、それまでには相当の時間を費やして試行錯誤しています。 >度重なるマナーの悪い方がいます ●問題があるようでしたら、御指摘お願い致します。 ★マクロの記録を利用し、本やヘルプを参照して勉強していますが、この課題も解決出来ないものが多々あります。 今後も、御指導いただく為に質問をさせていただきますので、「isekaoru」を見ましたら事情御賢察の上御指導宜しく御願いいたします。

その他の回答 (6)

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.7

こんにちは。 #6の回答者です。 >●私は、ボケ防止のため(68歳の無職)に勉強しております。 私の知り合いの人たちの年代と、そう変わらないです。 でも、掲示板には、年齢は関係がありません。相手の人たちが皆若い人たちだと思うと、そうでない人たちもいます。ここの常連さんでも、かなり年齢の上かと思わせる内容の人がいます。若い人もいれば、そうでない人もいます。日経の記事に、Excel-表計算の達人というのは、だいたいは50代以上で、そういう人たちが早期退職して、企業では、その抜けた穴の補充が利かないという話もあるぐらいです。 1980年の初めの頃からコンピュータを扱って、場合によれば、Basic からニーモニックを扱ってきた人たちと、1992年以降のWindows が最初の人では、知識も技術も差があって当然です。私の出会った人には、コンピュータを作るところから始めて、ほとんど、すべてのプログラミング言語を扱える人さえいます。私は、Windowsさえ扱うことになるなんて思っていなかったです。 Excelのマクロの勉強で、最初の半年ぐらいは、テキストどおり、他には手を出さないで段階的に一つずつ、レベルを上げていくのがよいです。出来るだけ基本どおりに進めたほうがよいです。いきなり、難しいことをやって、出来ない、分からないので掲示板で聞くというスタイルだと、なかなか上達できません。 例えば、ワークシート関数をVBAで用いるというのは、実務的には頻繁にあっても、トレーニングの段階では、理由はいくつかあるのですが、上級に入ります。イベント・ドリブン型マクロも、なかなか意味が理解しにくいです。テキストの選び方も大事だと思います。

isekaoru
質問者

お礼

Wendy02様 長文の御返事感謝申し上げます。

  • okormazd
  • ベストアンサー率50% (1224/2412)
回答No.5

たとえば、次のようなことですか。 意図されていることとは違うかもしれないが・・・。 ユーザーフォームにリストボックス1つ、テキストボックスを3つ、コマンドボタン(OKボタンとCANCELボタン)2つをつくります。 リストボックス名をhasuu、テキストボックス名をそれぞれsuu、tannka、kinngakuとします。 hasuuには処理条件、suu、tannka、kinngakuには、それぞれ数、単価、金額が入るのですが、数と単価をを入力し、処理条件を選ぶと金額に処理条件に応じて計算された金額が入ります。 処理条件のソースはQ1:Q3に入れておきます。 つぎのコードを貼り付けて実行(testを実行)してみてください。 UserFormのコードに貼り付け。 Private Sub cancel_Click() UserForm1.Hide End Sub Private Sub OK_Click() kgkeisan End Sub Private Sub UserForm_Initialize() hasuu.ColumnCount = 3 hasuu.RowSource = "Q1:Q3" kinngaku.Text = 0 suu.Text = 0 tannka.Text = 0 End Sub 以下、標準モジュール(module1)に貼り付け。 Sub test() UserForm1.Show End Sub Sub kgkeisan() With UserForm1 hli = .hasuu.ListIndex kintx = .suu.Text * .tannka.Text MsgBox kintx Select Case hli Case 0 kintx = Int(kintx + 0.5) Case 1 kintx = Int(kintx) Case 2 kintx = Int(kintx) + 1 Case Else MsgBox "計算できない" kintx = "--" End Select .kinngaku.Text = kintx End With End Sub

isekaoru
質問者

お礼

okormazd様 試行錯誤し遅くなりましたがありがとうございました。 これからも、宜しく御願いいたします。

  • okormazd
  • ベストアンサー率50% (1224/2412)
回答No.4

完成できないと思います。 まず、何をどうしたいのか明確ではありません。 書いてあるコードの前提がどうなのかわかりません。 コードが変だ。 hasuu.Text kinngaku.Text suu.Text tannka.Text これらは何なのでしょう。

  • zap35
  • ベストアンサー率44% (1383/3079)
回答No.3

>得意先マスターのQ列に入力してある、端数処理のコード(1~3)によって処理をしたい >Set trg = Workbooks("マスター.xls").Worksheets("得意先マスター") _ >.Range("Q:Q").Find(what:=hasuu.Text, LookIn:=xlValues, lookat:=xlWhole) 実際の画面を見ないとわかりませんが、ちょっと変ですね。得意先マスターをFindメソッドで検索するなら、 「what:=hasuu.Text」で検索するのは正しいですか? .Range("A:A").Find(what:=Kokyaku.Text, なら何となくわかりますが… 全く的外れかもしれませんが、TextBoxで入力された顧客名で「得意先マスター」シートのA列を検索し、Q列のコード(1~3)で処理を変えるマクロサンプルを書きます。意図と合っていなかったら読み飛ばしてください Private Sub CommandButton1_Click() Dim r As Range Dim tanka, suryo As Single   Set r = Sheets("Sheet1").Columns(1).Find(what:=TextBox1.Text, LookIn:=xlValues, lookat:=xlWhole)   If r Is Nothing Then 'マスタが見つからないときの処理     MsgBox "得意先マスタに該当なし"   Else  'マスタが見つかったとき     If IsNumeric(TextBox2.Text) Then 'TextBox2が単価       tanka = CDbl(TextBox2.Text) '数字と見なせるとき数値に変換     End If     If IsNumeric(TextBox3.Text) Then 'TextBox3が数量       suryo = CDbl(TextBox3.Text)     End If     Select Case Sheets("Sheet1").Cells(r.Row, "Q").Value     Case Is = 1  'TextBox4が金額       TextBox4.Text = Str(WorksheetFunction.Round(tanka * suryo, 0))     Case Is = 2       TextBox4.Text = Str(WorksheetFunction.RoundDown(tanka * suryo, 0))     Case Is = 3       TextBox4.Text = Str(WorksheetFunction.RoundUp(tanka * suryo, 0))     Case Else       TextBox4.Text = "マスタ区分不正"     End Select   End If End Sub

isekaoru
質問者

補足

zap35様 他の方からは変だとご指摘の質問に対し、大変お手数のかかる御丁寧な御指導本当にありがとうございました。 心より御礼申し上げます。 記述いただきましたマクロサンプルもあまり理解できないまま下記のように置換えさせていただきました。 第一法 (1)では思い通り出来ました。 第二法 数量*単価=金額 計算時に即金額を表示したいので、(1)の部分を(2)に変えました。 その結果 修飾子が不正のメッセージが表示され If IsNumeric(suu.Text) Then の suu が青くぬられています。 其の他に、型があわないと表示された場合がありました。 ●数量・単価は小数点以下2桁ほど使用します。 ★御願い 御指導いただきたいとは思いますが、勉強を始めたばかりの、68歳の老人です。 約8時間かかってこの程度です。 これ以上付き合うのは無理だと思われましたら、質問の締め切りも御座いますので、ご遠慮なく打ち切る旨だけ、御連絡お願い致します。 (1)Private Sub CommandButton4_Click()    (2)Private Sub tannka_Change() '金額計算 Dim r As Range Dim tanka, suu As Single Set r = Workbooks("マスター.xls").Worksheets("得意先マスター") _ .Columns(4).Find(what:=tokukoudo.Text, LookIn:=xlValues, lookat:=xlWhole) If r Is Nothing Then 'マスタが見つからないときの処理 MsgBox "得意先マスタに該当なし" Else 'マスタが見つかったとき If IsNumeric(tannka.Text) Then 'TextBox2が単価 tanka = CDbl(tannka.Text) '数字と見なせるとき数値に変換 End If If IsNumeric(suu.Text) Then 'TextBox3が数量 suu = CDbl(suu.Text) End If Select Case Workbooks("マスター.xls").Worksheets("得意先マスター").Cells(r.Row, "Q").Value Case Is = 1 'TextBox4が金額 kinngaku.Text = Str(WorksheetFunction.Round(suu * tannka, 0)) Case Is = 2 kinngaku.Text = Str(WorksheetFunction.RoundDown(suu * tannka, 0)) Case Is = 3 kinngaku.Text = Str(WorksheetFunction.RoundUp(suu * tannka, 0)) Case Else kinngaku.Text = "マスタ区分不正" End Select End If 'End Sub

回答No.2

VBで四捨五入する方法を書き忘れました。

参考URL:
http://snyc.s28.xrea.com/contents/002.htm
isekaoru
質問者

お礼

grghbdjujf様 二度にわたり御指導ありがとうございました。 お気に入りに追加しました。

回答No.1

まず、VBのRound関数は四捨五入ではありません。 四捨五入については参考URLをご参照ください。 WorksheetFunctionというクラスを使うとエクセルのワークシート関数がVBで使えるようになります。 四捨五入 WorksheetFunction.Round 切り上げ関数 WorksheetFunction.RoundUp 切り捨て関数 WorksheetFunction.RoundDown

関連するQ&A

  • VBA の IF then 文につぃて

    access2000でテーブルに連結していないフォームがあり その中のテキストボックスにバーコードや磁気カードで読み込ませその桁数によって処理を分けようと思っていますが、どのようにコードを書けばよいのかおしえてください。 たとえば、 private sub() if 入力テキスボックス が 8桁 then 磁気カード処理 if 入力テキストボックスが 11桁 then バーコード処理 end if end sub public sub 磁気カード処理() public sub バーコード処理() のような形です。 どうかお願いします

  • エクセルのVBAで、エラーになった場合の回避

    excel2000 VBA エラーが発生した場合の処理の方法についてアドバイスをお願いいたします。 データベースのレコードを操作する、4つのプロシージャが下記の通りあります。 (1)最初(saisyo) (2)最後(saigo) (3)前(mae) (4)次(tugi) いきなり、(3)前、(4)次の処理を実行すると、エラーになってしまうのですが、これをなくしたい。(on error gotoステートメントを使えばいいのかなと考えていますが) ワークブックオープン時のイベントで(2)最後(saigo)を呼び出しているので、基本的にエラーは出ないのですが、いろいろレコードを触っている時に、(3)、(4)を実行するとエラーになるのがわずらわしいです。 どういう修正をコードに加えればいいか、アドバイスいただけるとありがたいです。 Public trg As Range Sub Saisyo() Set trg = Worksheets("data").Range("A1") Do Set trg = trg.Offset(1, 0) Loop Until trg.EntireRow.Hidden = False Call Tenki End Sub Sub Saigo() Set trg = Worksheets("data").Range("A60000").End(xlUp) Call Tenki End Sub Sub Mae() If trg.row >= 3 Then Do Set trg = trg.Offset(-1, 0) Loop Until trg.EntireRow.Hidden = False If trg.row = 1 Then MsgBox "これより前のレコードはありません" Call Saisyo Exit Sub Else Call Tenki End If Else MsgBox "これより前のレコードはありません!" End If End Sub Sub Tsugi() If trg.row < Worksheets("data").Range("A60000").End(xlUp).row Then Do Set trg = trg.Offset(1, 0) Loop Until trg.EntireRow.Hidden = False Call Tenki Else MsgBox "これより後ろのレコードはありません" End If End Sub Sub Tenki() 'レコードのtrgの値を入力シート(input)のBC1セルに表示させる Worksheets("input").Range("BC1").Value = trg End Sub

  • エクセルVBAのIf ~ Thenステートメントで

    予約フォームの作成に挑戦しています。 予約日が2022年8月1日の時のみ、シート4に結果を記入して行きたいのですが、 Private Sub CommandButton1_Click() If ListBox1.Text = "44774" Then Sheet4.Select Range("C2").End(xlDown).Offset(1, 0).Select ActiveCell.Value = Reservationform.ListBox2.Value ActiveCell.Offset(0, 1).Value = Reservationform.ListBox3.Value ActiveCell.Offset(0, 2).Value = Reservationform.ListBox4.Value ActiveCell.Offset(0, 2).NumberFormat = Range("C2").NumberFormat Exit Sub End If End Sub で、とりあえず成功しています。 "44774" の部分を、"Sheet6のA2"だった時のみ結果を記入するようにしたいです。 " "の中身をそのまま変えて、 If ListBox1.Text = "sheet6.Range("A2")" Then や If ListBox1.Text = "sheet6.Cells(2, 1).Value" Then に変えてみましたがうまく行きませんでした。 どのようにしたら良いでしょうか?

  • excel vba のエラー原因が分かりません

    データ入力シート「Hit Data] データ表示シート「User Sheet」 とあります。 データ表示シート「User Sheet」に「次へ」「前へ」「最初へ」「最後へ」とボタンをつくり、データ入力シート「Hit Data]から、都度データを呼び出せるようにするプログラムをとあるサイトを参考にして作成しましたが、エラーが出てしまいどうしてもうまくいきません。 どこに問題があるのか見ていただけないでしょうか? '以下標準モジュールのプログラムです Public trg As Range Sub Saisyo()  Set trg = Worksheets("Hit Data").Range("A3")  Call Tenki End Sub Sub Saigo()  Set trg = Worksheets("Hit Data").Range("A60000").End(xlUp)  Call Tenki End Sub Sub Mae()  If trg.Row >= 4 Then   Set trg = trg.Offset(-1, 0)   Call Tenki  Else   MsgBox "これより前のレコードはありません"  End If End Sub Sub Tsugi()  If trg.Row < Worksheets("Hit Data").Range("A60000").End(xlUp).Row Then   Set trg = trg.Offset(1, 0)   Call Tenki  Else   MsgBox "これより後ろのレコードはありません"  End If End Sub Sub Tenki()  Worksheets("User Sheet").Range("D9").Value = trg.Offset(0, 0)  Worksheets("User Sheet").Range("D10").Value = trg.Offset(0, 1)  Worksheets("User Sheet").Range("D11").Value = trg.Offset(0, 2)  Worksheets("User Sheet").Range("D12").Value = trg.Offset(0, 3) End Sub '以下 User Sheet"のシートモジュールに記載されたプログラムです。 Private Sub Worksheet_Activate() Call Saisyo End Sub '表示されるエラーの内容 'saisyo・・・アプリケーション定義またはオブジェクト定義のエラーです。 'saigo・・・同上 'mae・・・オブジェクト変数またはWithブロック変数が設定されていません 'tugi・・・同上

  • excel VBA コード編集のアドバイス

    下記データベースをexcelで作成しようとしています。 ■「data」シート ・・・データを入力するシート ■「input]シート ・・・データを入力してdataシートに格納する、またdataシートで入力した値をほしい情報を表示させるシート ■やろうとしていること、困っていること ・・・dataシートのA列でID番号を入力しておりますが、dataシートでオートフィルタを使う場合があり、その場合、IDが飛び飛びになるのですが、下記コマンドボタンだと、それに合わせて飛んでくれません。 ■相談したいこと これを解決するために、オフセットでは、無理ということは分かるのですが、じゃぁどういったコードを組めばいいのかをアドバイスをお願いできないでしょうか。どうかよろしくお願いいたします。 '■以下コードです。 Public trg As Range Sub Mae() '前へのボタン If trg.row >= 3 Then Set trg = trg.Offset(-1, 0) Call Tenki Else MsgBox "これより前のレコードはありません" End If End Sub Sub Tsugi() '次へのボタン If trg.row < Worksheets("data").Range("A60000").End(xlUp).row Then Set trg = trg.Offset(1, 0) Call Tenki Else MsgBox "これより後ろのレコードはありません" End If End Sub Sub Tenki() Worksheets("input").Range("c4").Value = trg.Offset(0, 0) End Sub

  • EXCEL VBA エラーの意味が分からず

    いつも、お世話になっております。 下記コードで、レコード1と2を前へと次へを繰り返し何度か操作すると、エラーになってしまいます。なぜエラーになって、どう修正すれば回避できるのかが分かりません。 どうかご教授いただけないでしょうか。よろしくお願いいたします。 エラーの状況 inputシートで、maeとtsugiの動作を何度か行うと、「If pict.TopLeftCell.Address = targetRange.Address Then」の部分が黄色く塗りつぶされ、「実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーです。」と表示されてしまします。たぶん写真の削除の時にエラーになっているのだと思いますが、 '■標準モジュールのコード。dataシートのレコードを移動し、inputシートのBC1セルに表示する。 Public trg As Range Sub Saisyo() Set trg = Worksheets("data").Range("A1") Do Set trg = trg.Offset(1, 0) Loop Until trg.EntireRow.Hidden = False Call Tenki End Sub Sub Saigo() Set trg = Worksheets("data").Range("A60000").End(xlUp) Call Tenki End Sub Sub Mae() On Error GoTo errhandle If trg.row >= 3 Then Do Set trg = trg.Offset(-1, 0) Loop Until trg.EntireRow.Hidden = False If trg.row = 1 Then MsgBox "これより前のレコードはありません" Call Saisyo Exit Sub Else Call Tenki End If Else MsgBox "これより前のレコードはありません!" End If Exit Sub errhandle: Call Saisyo End Sub Sub Tsugi() On Error GoTo errhandle If trg.row < Worksheets("data").Range("A60000").End(xlUp).row Then Do Set trg = trg.Offset(1, 0) Loop Until trg.EntireRow.Hidden = False Call Tenki Else MsgBox "これより後ろのレコードはありません" End If Exit Sub errhandle: Call Saigo End Sub Sub Tenki() Worksheets("input").Range("BC1").Value = trg.Offset(0, 0) End Sub '■sheet 1のモジュール。inputシートBC1セルの値を見て、dataシートへ値を読みにいき、inputシートへ表示する。 Private Sub hyouji() Dim fRange As Range Dim kensaku As Long Set fRange = Sheets("data").Columns(1).Find(What:=Range("BC1").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) If (fRange Is Nothing) Then '見つからなかった? MsgBox "入力された顧客コードが存在しません。", vbExclamation Exit Sub End If kensaku = fRange.row '検索された顧客DCの行位置を求める Range("BC1:BE1").Value = Sheets("data").Cells(kensaku, 1).Value '整理No Range("AX1").Value = Sheets("data").Cells(kensaku, 2).Value '固有ID Range("I4").Value = Sheets("data").Cells(kensaku, 3).Value '工場名 Range("P4").Value = Sheets("data").Cells(kensaku, 4).Value '柱No Range("W4").Value = Sheets("data").Cells(kensaku, 5).Value '盤No Range("I5").Value = Sheets("data").Cells(kensaku, 6).Value '変台系統1 Range("S5").Value = Sheets("data").Cells(kensaku, 7).Value '変台系統2 Range("I6").Value = Sheets("data").Cells(kensaku, 8).Value '分電盤設置時期 Range("B8").Value = Sheets("data").Cells(kensaku, 9).Value '主な供給先 Range("B14").Value = Sheets("data").Cells(kensaku, 10).Value '特記 Range("AD4").Value = Sheets("data").Cells(kensaku, 11).Value '盤位置の目安 Range("AT8").Value = Sheets("data").Cells(kensaku, 12).Value '幹線線相 Range("R36").Value = Sheets("data").Cells(kensaku, 13).Value '盤写真ファイル名 Range("AT36").Value = Sheets("data").Cells(kensaku, 14).Value '単結図ファイル名 End Sub '■sheet 1のモジュール。"$R$36"と"$AT$36"の写真ファイル名を見て、"C37"と"AE37"セルに表示させる。 Private Sub Worksheet_Change(ByVal Target As Range) Dim fRange As Range Dim touroku As Long Select Case Target.Address Case "$BC$1" Call hyouji Case "$R$36" myLoadPicture "board_Image", Target.Text, Range("C37") Case "$AT$36" myLoadPicture "map_Image", Target.Text, Range("AE37") Case "$AT$8" Call red_circle Case Else Exit Sub End Select End Sub Private Sub myLoadPicture(folderName As String, fname As String, targetRange As Range) Dim pict As Shape, picPath As String picPath = ThisWorkbook.Path & "\" & folderName & "\" & fname If fname = "" Then picPath = ThisWorkbook.Path & "\" & folderName & "\" & "NoImage.jpg" End If With ActiveSheet For Each pict In .Shapes If pict.TopLeftCell.Address = targetRange.Address Then pict.Delete Exit For End If Next pict Set pict = .Shapes.AddPicture(picPath, msoTrue, msoFalse, _ targetRange.Left, targetRange.Top, 300, 360) End With End Sub

  • エクセルVBA 前回のご回答で質問です

    http://oshiete1.goo.ne.jp/qa3764996.html 前回上の質問をさせていただき、お二方から大変よいご回答をいただきました。 これを勉強したいと思い、読み取ろうとしたのですが、理解できないところがあり、日本語にすればどのようになるのかお教えいただきたいと思い、質問にまた参りました。分からないところは、下の全コード中の、 r.Offset(0, -1).Resize(1, 2).Interior.ColorIndex = trg.Interior.ColorIndex '    r.Offset(0, -1).Resize(1, 2).Font.ColorIndex = trg.Font.ColorIndex の部分です。OffsetとResizeでの行、列の方向性が理解できないのです。よろしければコメントを着けていただければ助かります。 よろしくお願いします。 Sub Macro1() Dim r, trg As Range  For Each r In Range("B4:AD27")   If r.Value <> "" Then    Set trg = Range("B1:O1").Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole)    If Not trg Is Nothing Then     r.Offset(0, -1).Resize(1, 2).Interior.ColorIndex = trg.Interior.ColorIndex '    r.Offset(0, -1).Resize(1, 2).Font.ColorIndex = trg.Font.ColorIndex    End If   End If  Next r End Sub

  • excel VBA コードの編集 アドバイス依頼

    いつもお世話になっております。 初心者ですが、苦しみながらもaccessを意識したデータベースをexcelで作成しようとしております。 さて 下記 Worksheet_シートが2つあり、それぞれのシートで IDを関連付ける主キーにしてデータを管理しています。 ■1枚目「input」シート ・・・ データを入力・閲覧するシート(accessでいうフォームにあたります)、主キーはC4セルに入力しています。 ■2枚目「data」シート ・・・ inputシートで入力・編集されたデータを保管するするシート(accessでいうとテーブルにあたります)。主キーはA列に登録されています。 ■データの閲覧方法 ・・・inputシートに、「最初へ」「前へ」「次へ」「最後へ」と4つのボタンをinputシートに設けて、主キー番号を可変させてデータを閲覧できるようにしています。また、C4セルに直接数字を入力しても、データをdataシートへ読みにいって、表示させられるようにしています。 ■困っていること、 ・・・C4セルに数字を打ち込んでデータを閲覧した後、「前へ」「次へ」ボタンを押すと、エラー(オブジェクト変数または、withブロック・・・)または、全く違う番号にジャンプしてしまいます。 ■お願いしたいこと ・・・C4セルに数字を打ち込んでデータを閲覧した後、、「前へ」「次へ」ボタンを押して、その前後のデータが確認できるようなコードに修正したいのですが、どういったコードにすればいいか教えていただけないでしょうか? コードは下記です。 また、どういったものを作ろうとしているのか説明不足でご指摘を頂戴することもありますので、試作段階のファイルですが、アップローダーにあげさせていただきました。確認頂ければ幸いです。 ■アプロダ 投稿No 4520 http://www.kent-web.com/pubc/book/test/uploader/uploader.cgi ■↓以下 関係あると思われるコード抜粋です '■レコードの移動コード(標準モジュールに記載) Public trg As Range Sub Saisyo() Set trg = Worksheets("data").Range("a1") Do Set trg = trg.Offset(1, 0) Loop Until trg.EntireRow.Hidden = False Call Tenki End Sub Sub Saigo() Set trg = Worksheets("data").Range("A60000").End(xlUp) Call Tenki End Sub Sub Mae() If trg.row >= 3 Then Do Set trg = trg.Offset(-1, 0) Loop Until trg.EntireRow.Hidden = False If trg.row = 1 Then MsgBox "これより前のレコードはありません" Call Saisyo Exit Sub Else Call Tenki End If Else MsgBox "これより前のレコードはありません!" End If End Sub Sub Tsugi() If trg.row < Worksheets("data").Range("A60000").End(xlUp).row Then Do Set trg = trg.Offset(1, 0) Loop Until trg.EntireRow.Hidden = False Call Tenki Else MsgBox "これより後ろのレコードはありません" End If End Sub Sub Tenki() Worksheets("input").Range("c4").Value = trg.Offset(0, 0) End Sub '■ワークシートチェンジコード(ワークシートに記載) Private Sub Worksheet_Change(ByVal Target As Range) Dim fRange As Range Dim fRow As Long Select Case Target.Address Case "$C$4" Set fRange = Sheets("data").Columns(1).Find(What:=Range("C4").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) If (fRange Is Nothing) Then '見つからなかった? MsgBox "入力された顧客コードが存在しません。", vbExclamation Exit Sub End If fRow = fRange.row '検索された顧客DCの行位置を求める Range("F4").Value = Sheets("data").Cells(fRow, 2).Value Range("C5").Value = Sheets("data").Cells(fRow, 3).Value Range("C6").Value = Sheets("data").Cells(fRow, 4).Value Range("C7").Value = Sheets("data").Cells(fRow, 5).Value Range("F5").Value = Sheets("data").Cells(fRow, 6).Value Range("k4").Value = Sheets("data").Cells(fRow, 7).Value Range("k17").Value = Sheets("data").Cells(fRow, 8).Value Case "$K$4" myLoadPicture "board_Image", Target.Text, Range("I5") Case "$K$17" myLoadPicture "map_Image", Target.Text, Range("I18") Case Else Exit Sub End Select End Sub

  • エクセル・マクロでIf Thenの使い方

    このような質問は、ルール(エチケット、マナー)違反になるでしょうか? もしそうならお許し下さい。 名前ボックスに表示される名前を、マクロで非表示にし、元に戻す、という操作を次の二つのボタンで実行するように作りました。エクセル2003です。 Private Sub CommandButton1_Click() Dim tname As Name For Each tname In ThisWorkbook.Names tname.Visible = False Next End Sub Private Sub CommandButton2_Click() Dim tname As Name For Each tname In ThisWorkbook.Names tname.Visible = True Next End Sub これを一つのボタンで、If Then Elseを使い実行できるようにしたいのですが If ・・・ Then の間の書き方が分からずうまくいきません。   If Names.Visible = False Then   If ThisWorkbook.Names.Visible = False Then If ThisWorkbook.tname.Visible = False Then Private Sub CommandButton3_Click() Dim tname As Name If Names.Visible = False Then 'これでは駄目 For Each tname In ThisWorkbook.Names tname.Visible = False Next Else For Each tname In ThisWorkbook.Names tname.Visible = True Next End If End Sub 苦し紛れにこんなことをやってごまかそうとしているのですがこれって邪道ですしかっこうわるいですよね。 Private Sub CommandButton3_Click() Dim tname As Name If Range("g1").Value = " " Then   For Each tname In ThisWorkbook.Names   tname.Visible = False   Next Range("g1").Value = "1" Else   For Each tname In ThisWorkbook.Names   tname.Visible = True   Next Range("g1").Value = " " End If End Sub ど素人ですがよろしくご教導ください。

  • If ~Then文

    2つの方法をIf ~Then文により処理したいと思います。 A1~I1のどこかに「価格」文字が入っています。 その「価格」がA1なら(1)パターンを実行、それ以外なら(2)パターンを実行 *(2)パターン実行時は「価格」セルを探してから。(E1) (1)パターン m = ActiveSheet.Range("A3").End(xlDown).Row Range("A1:E" & m).Select Range("B1:E" & m).Select Selection.ClearContents Range("F1").Select (2)パターン n = ActiveSheet.Range("A3").End(xlDown).Row Range("E1:I" & n).Select Selection.Cut Range("A1").Select ActiveSheet.Paste Range("F1").Select お願い致します。

専門家に質問してみよう