エクセル2003です。
インプットBOXに数値を入力してもらいます。
整数で1文字以上~8文字以内にさせたいです。
(1)キャンセル選択
(2)間違った入力
(3)未入力でOKを選択
の場合記述してある再入力を促すMsgBoxを表示させたいです。
また(2)(3)はMsgBox表示の後インプットBox入力に戻したいです。
以下に掲載した構文で行うと

(1)インプットBOXの「キャンセル」選択時
→「終了」MsgBox表示(正常)

(2)数字以外を入力した時
→Type:=1にしてある為「数値が正しくありません」
 と記述してあるMsgBoxではないが警告メッセージが表示(正常)

・9文字以上入力した場合
→「再入力」MsgBox表示(正常)

・1文字~8文字を入力した場合
→次の処理に進む(正常)

(3)何も入力せず空白の状態でインプットBoxの「OK」を選択
→記述してあるMsgBoxではなく
「入力した数式は正しくありません」と書かれたヘルプ付き警告が
表示されてしまいます。 
この時は上記同様に記述内にある
再入力を促すMsgBox
を表示させたいのですがどう記述すればいいのか分かりません。

インプットBoxのType:=1をはずせば
記述してあるMsgBoxが表示するようになりますが
今度は整数以外が入力できてしまいます。
よろしくお願いします。

Do
指示数 = Application.InputBox("指示数を数字で入力してください ", Type:=1)
If 指示数 = "False" Then 'キャンセル選択時
MsgBox "終了します", vbExclamation, "注意"
Call 定位置 
Exit Sub 
End If
'1文字以上8文字以内の時はループを抜けて次の処理へ
If Len(指示数) <= 8 Then
Exit Do 'Loopを抜けて次の処理へ
End If
MsgBox "ケタ数が違います。再入力してください", vbCritical, "エラー!!"
Loop 'インプットBoxに戻る
---次の処理

このQ&Aに関連する最新のQ&A

A 回答 (5件)

No.4です。



お礼と補足欄の内容を見させていただきました。
意図通りの動きになったのでしたら何よりです。
ただ、幾つか気になる点がありましたので、補足させてください。

【StrReverseについて】
上記関数は、「123」を「321」に、「ABC」を「CBA」に、と、文字列の
並び順を逆転させます。
前回の回答では、(こちらでの勝手な解釈で)「1.0」は弾きつつ「1.」は
許可する、という動作をさせるために使用しました。
(「1.」を「.1」とし、InStr関数の第1引数に「2」を指定することで、
 反転後に先頭となる「.」を、InStr関数の判定対象から外した、と)

ですので、位置によらず「.」や「+」等を弾きたい場合は、上記関数は
不要です(汗)
(「InStr(StrReverse(指示数2), "+")」は「InStr(指示数2, "+")」で
 Ok、と)


【InStrについて】
この関数では、第4引数の指定により、全角/半角を同一とみなすか
どうかを指定できます。
(省略した場合は、モジュール先頭の「Option Compare ○○」での
 指定によって変化)

同一扱いにする場合は、
 InStr(1, 指示数, ".", vbTextCompare)
と、「vbTextCompare」(または「1」:クエリではこちらのみ有効)を
指定します。
なお、第4引数指定時は、第一引数(開始位置)も省略できなく
なるのでご注意下さい。


【数字以外を含むかどうかの判定法について】
小数点や正負の記号も含め、「0~9」の数字以外の全てを弾く
のでしたら、「Replace関数でそれらを消した後に文字が残るか
どうか」という判定方法もあるかと思いますので、参考までに・・・。
(以下、追加が必要になると思われる部分のみ記述。実際に
 組み込む場合は、適宜分割して、必要な場所に埋め込んで
 下さい:
 変数宣言は先頭、変換は「ElseIf~」の分岐の中、など)

Dim sRemain As String, i As Integer

'評価用の変数に入力値を記録
sRemain = 指示数2

'「0~9」の数字を全て空文字に変換
For i = 0 To 9
  '変換後の値を、同じ変数に再格納
  sRemain = Replace(sRemain, i, "")
Next

'数字全てを空文字に変換した後に、何らかの文字が残った場合
'(「1,,,,,,6」の場合、MsgBoxには「,,,,,,は入れては~」と表示されます)
If Len(sRemain) Then  '「0」以外は条件成立扱いになります
  MsgBox sRemain & "は入れてはいけません(>_<)" & vbCrLf & _
    "再入力してください", vbCritical, "エラー!!"
End If


※これとは別に、「正規表現」を使用する方法もあります。
  ただ、こちらはややとっつきにくいところがあるのと(→自分もまだ
  習得未了(汗))、「実際にどの文字が問題なのか」を表示する
  にはやや不適と思われますので、紹介のみに留めておきます(汗)
http://codezine.jp/article/detail/1655
http://officetanaka.net/excel/vba/tips/tips38.htm
    • good
    • 0
この回答へのお礼

ご丁寧にありがとうございます。
【StrReverseについて】
ヘルプで見て内容は理解していました。
IsNumericが数値ではないのに
Trueを返してしまう文字の中に
123-
が有ります。
並び順をかえると-123
この時にためにStrReverseを使ったのかな?
と思っていました。

今よく見たら
123-
と入力した場合は
If InStr(2, StrReverse(指示数2), ".") Then
ではなく
ElseIf 指示数2 <= 0 Then
で判定されていました。(^_^.)

またIsNumericが数値ではないのにTrueを返してしまう
文字対策の方のずらずらと並べた方は
StrReverseをそのまま適用しましたが
第一引数を2ではなく省略しました。
ヘルプでは
省略→先頭から検索される
とあったので省略すれば
上から読んでも下から読んでも山本山
ではなく、どこに「+」「,」「D」「E」が有っても
検索可能だから逆でも大丈夫だと思いそのままにしました。

今試したら教えていただいたとうり
1.が通過してしまいます。(滝汗)
これはやばいです。
1.が通過すると後の方の処理で
VBEのエラー画面が出てしまい
使用者がパニくってしまいます。

(おかしいなあ。予想される入力は全部やってみたのですが。
 1.も試した(はじいた)記憶が....キット思い過ごしです。(^_^.)

【InStrについて】
ここでかなり悩んでしまいました。
数字で有るなら、全角でも半角でも通過させたかったからです。
全角で1.5だとはじいてくれなくて
ヘルプも見たのですが.....
今見直すと
「vbTextCompare 1 テキスト モードの比較を行います。」
とありますね。
テキスト→全角、半角の区別をしない
とは行き着きませんでした。

(-_-;)駄目ですね。
私はPC操作もエクセル使用も向いてないんです。
それなのにマクロをなんて、無理なんですよね。

絶対ここで質問しないと決めたのですが
本件は質問してしまったし.....。

今別件で悩んでます。(T_T)
構文の記述ではなく
どう処理するかが決めれなくて。

あっ。すいません。本件には関係ありませんね。

とりあえずリリースしてしまったので

「InStr(StrReverse(指示数2), "+")」
 ↓
「InStr(指示数2, "+")」
に修正してきます。

いろいろとありがとうございました。

お礼日時:2011/04/25 17:49

No.2です。



> インプットBOXに空白でOKを選択時は
> 入力忘れと仮定して
> 記述した「再入力を促すMsgBox」を表示させたいのです。

でしたら、VBAのInputBox関数からApplication.InputBoxに戻す必要がありますね(汗)

前回の回答に対して、以下のように改修すれば、ご希望の動作になるかと思います。

【現状(改修部分のみ抜粋・コメントは省略)】

  指示数 = InputBox("指示数を数字で入力してください")

  If 指示数 = "" Then

【改修後(抜粋部分を置き換え)】

  指示数 = Application.InputBox("指示数を数字で入力してください")

  If 指示数 = "" Then
    MsgBox "空白は指定できません"
  ElseIf 指示数 = "False" Then



・・・以上です。
取り急ぎ、参考まで。

この回答への補足

Do '指示数を変更する為に入力
指示数 = Application.InputBox(Prompt:="指示書に表示したい" _
& vbCrLf & "【指示数】" & vbCrLf & "を数字で入力してください")
If 指示数 = "" Then '(3)入力値確認分岐開始、空白でOKを押時
MsgBox "空白は指定できません(>_<)", vbCritical, "エラー!!"
ElseIf 指示数 = "False" Then '(3)分岐2種類目、キャンセル選択時
If MsgBox("終了します", vbOKCancel + vbExclamation, "確認") = _
vbOK Then
Call 定位置 'OK押時
Exit Sub
End If 'キャンセル押時
ElseIf IsNumeric(指示数) Then '(3)分岐3種類目、数値の場合
指示数2 = StrConv(指示数, vbNarrow) '全角→半角
'IsNumericがTrueを返した時の確認
If InStr(2, StrReverse(指示数2), ".") Then '小数指定時と123.56対応
MsgBox "小数点は駄目です。(>_<)" & vbCr & _
"再入力してください", vbCritical, "エラー!!"
ElseIf Len(指示数2) > 8 Then '桁数オーバー時
MsgBox "桁数が違います。(>_<)" & vbCr & _
"再入力してください", vbCritical, "エラー!!"
ElseIf 指示数2 <= 0 Then '負の数字と-123対応
MsgBox "負(マイナス)の数は駄目です(>_<)" & vbCr _
& "再入力してください", vbCritical, "エラー!!"
'IsNumericが数値ではないのにTrueを返してしまう文字の対策
ElseIf InStr(StrReverse(指示数2), "+") Then '+123と123+対応
MsgBox "+は入れてはいけません(>_<)" & vbCr & _
"再入力してください", vbCritical, "エラー!!"
ElseIf InStr(StrReverse(指示数2), "-") Then '123-対応
MsgBox "-は入れてはいけません(>_<)" & vbCr & _
"再入力してください", vbCritical, "エラー!!"
ElseIf InStr(StrReverse(指示数2), ",") Then '1,,,,,,6対応
MsgBox ",はいれては行けません(>_<)" & vbCr & _
"再入力してください", vbCritical, "エラー!!"
ElseIf InStr(StrReverse(指示数2), "E") Then '3E2対応
MsgBox "Eは入れてはいけません(>_<)" & vbCr & _
"再入力してください", vbCritical, "エラー!!"
ElseIf InStr(StrReverse(指示数2), "D") Then '3D2対応
MsgBox "Dは入れてはいけません(>_<)" & vbCr & _
"再入力してください", vbCritical, "エラー!!"
Else 'IsNumericがTrueを返した時の確認を全て通過した時
Exit Do 'Doを抜ける
End If
Else '(3)分岐4種目、数値以外
MsgBox "数値以外は駄目です(>_<)" & vbCr & _
"再入力してください", vbCritical, "エラー!!"
End If '(3)分岐終了
Loop

補足日時:2011/04/21 16:59
    • good
    • 0
この回答へのお礼

お礼が遅れて申し訳まりません。

>ご希望の動作になるかと思います。

はい。なりました。
インプットBOXには
全角、半角問わず(まじっても可)で
1~99999の整数以外の入力ははじきたいのですが
自分のやり方では
負の数字や0、小数点がはじかれないので
教えていただいた物を使う事にしました。

ただ
If InStr(2, StrReverse(指示数2), ".") Then
が全角では判定しないので
IsNumericが数値と判定した時点で全角を半角に
するようにしました。

ElseIf IsNumeric(指示数) Then '(3)分岐3種類目、数値の場合
指示数2 = StrConv(指示数, vbNarrow) '全角→半角

またIsNumericが数値ではないのにTrueを返してしまう

123.56
123,56
1,,,,,,6
.56
+123
-123
123+
123-
3E2
3D2
の対策で
LikeとかFindとかいろいろ試しましたが駄目でしたので
InStrを複数作成しました。
できあがった構文は
追記に入れました。
どうもありがとうございました。

お礼日時:2011/04/21 16:54

NO1です。


>全角でも半角でも受け付けるようにしています。
 ⇒この処理を前倒しにする方法がベターだと思います。
  余裕があれば、面倒ですがユーザフォームを作成して入力する方法は如何でしょうか。
  テキストボックスのプロパティからIMEモードや入力長制限を設定できますのでご検討
  下さい。(参考サイトのURL添付します)

参考URL:http://www.eurus.dti.ne.jp/~yoneyama/
    • good
    • 0
この回答へのお礼

ありがとうございます。
今回教えていただいた内容ですが
現在の私の技量では
ちょっと難しくて対応が難しいです。
申し訳ありません。

お礼日時:2011/04/12 10:32

横レス失礼します。



「入力値を【数値とみなせる】か」は、IsNumeric関数で判定できますので、
Type引数は省略した上で、全チェックをマクロで行うのがよいかと思います。

Do
  指示数 = InputBox("指示数を数字で入力してください")

  'キャンセル/空白時
  If 指示数 = "" Then

    '取消の確認  ◆キャンセルの取消に対応してみました◆
    If MsgBox("終了します", vbOKCancel + vbExclamation, "確認") = vbOK Then
      Call 定位置
      Exit Sub
    End If

  '数値の場合
  ElseIf IsNumeric(指示数) Then

    '小数指定時
    If InStr(2, StrReverse(指示数), ".") Then
      MsgBox "整数を入力してください", vbCritical, "エラー!!"

    '桁数オーバー時
    ElseIf Len(指示数) > 8 Then
      MsgBox "桁数が違います。再入力してください", vbCritical, "エラー!!"

    'もし0や負の数も弾きたい場合は、以下の2行の先頭の「'」を外します
    'ElseIf 指示数 <= 0 Then
    '  MsgBox "正の整数を入力してください", vbCritical, "エラー!!"

    Else
      Exit Do

    End If

  '数値以外
  Else                 '【数値以外】
    MsgBox "数値を入力してください", vbCritical, "エラー!!"

  End If
Loop


【注意と説明】
・If文では、関数の戻り値が「0以外の整数」や「False」以外は、Trueと
 みなされるため、「IsNumeric」等に対する「=True」は省略しています。
・上では「Application.InputBox」ではなく、VBA関数のInputBoxを使用して
 います。キャンセル選択時の戻り値が異なるので注意してください。
 (今回は取消と空白の区別が不要のようでしたので、上記の通りとしました)
・小数かどうかは、「.」の有無で判定しています。
 但し、「1.」は「1」とみなすよう、末尾の「.」(→StrReverse関数で文字列を
 逆順に並べ替えると先頭)は、対象から外しました。
 なお、「1.0」も「1」とみなして許容する場合は、小数の判定部分を以下の
 ように変更すれば対応できます:

    '小数指定時
    If 指示数 <> CLng(指示数) Then

 ※強制的に整数化したものと元の値が同じなら整数、違えば小数、と。
  (InputBoxで「1.00」と指定しても、CLngの戻り値との比較時には
   数値とみなされて判定されるようです)
    • good
    • 0
この回答へのお礼

ありがとうございます。
ご回答いただく前に
http://okwave.jp/qa/q2872556.html
にあった方法で

Typeを外して
If Len(指示数) <= 8 Then

If Len(収容数) <= 8 And IsNumeric(収容数) Then
にするだけで対応ができました。
4→半角でも
4→全角でも
Exit Doで次の処理にいけます。
また入力内容に数字以外があれば
記述した再入力を促すMsgBoxが表示されました。

ただし値が以下の場合、エラーにならないです。
以下の場合は
記述した再入力を促すMsgBoxが表示したいのですが
Exit Doでループを抜けて次の処理に行ってしまいます。

123.56
123,56
1,,,,,,6
.56
+123
-123
123+
123-
3E2
3D2

教えていただいた記述をそのまま使わせていただきました。
インプットBOXに空白でOKを選択した場合
「入力した数式は正しくありません」は表示しなくなりましたが
キャンセル選択時同様最終的には
Exit Subになってしまいました。
インプットBOXに空白でOKを選択時は
入力忘れと仮定して
記述した「再入力を促すMsgBox」を表示させたいのです。
ちょっとわがままな仕様かもしれません。
どうもありがとうございました。

お礼日時:2011/04/12 10:30

InputメソッドのTypeを外し、次のコードを変更で如何でしょうか。


If Len(指示数) <= 8 Then ⇒ If Len(指示数) <= 8 And Val(指示数) Then 

この回答への補足

申し訳ありません。

Val関数は
文字列に数字以外があった場合読込を止める
とヘルプにありました。

12345ABCと入力すると
12345だけが返り8文字以内なので
次の処理へ移りますが
12345678のつもりで
12345ABCと入力したと仮定しなければ
なりませんのでエラーでないとまずいのです。
同じく
123456の所
123X56と誤って入力した場合
123だけが返ってしまい次の処理に移ってしまいます。

インプットBoxへの入力は
・1文字~8文字以内でそれ以外はエラー
・整数である事
・入力内に数字以外があったらエラー
・整数なら全角でも半角でもOK
・空白でOKを選択してもエラー
・エラーは記述したMsgBoxを表示

としたいのですが、やはりType:=1を入れるべきでしょうか?
これなら空白でOKを選択した時意外は
思ったとおりの動きなんですが....

補足日時:2011/04/08 11:09
    • good
    • 0
この回答へのお礼

ありがとうございます。

空白でOKを選択すると
記述したMsgBoxが表示されました。
また数値以外が入っていても
記述したMsgBoxが表示されました。
ただ
4と半角なら通過しますが
4と全角だとはねられて
記述したMsgBoxが表示されてしまいます。

次の処理で
指示数2 = StrConv(指示数, vbNarrow) '全角→半角
があり
インプットBOXへの入力は
数字1文字以上8文字以内なら
全角でも半角でも受け付けるようにしています。
(入力者がPC苦手でひらがなのまま数字入力する場合が
 あり入力者は正しいと思っている。)
よって全角ではねられると作業者から呼ばれるので
それが困りました。

お礼日時:2011/04/08 10:21

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QExcel VBAで、Application.InputBoxのキャンセルと入力値ゼロを区別したい。

VBA初心者です。
Application.InputBox(メソッド)で、キャンセルが選択されたら処理を終了し、数値が入力されたら計算をしたいのですが、ゼロを入力した場合にFalseと見なされて処理を終了してしまいます。ゼロを入力しても処理を続けるには、どのように記述すれば良いのでしょうか?よろしくお願いします。

Aベストアンサー

こんな感じでは

Sub aaa()

Dim ret As String


ret = Application.InputBox("数字を入力下さい", , , , , , , 2)

If ret = "" Then
MsgBox "何も入力されていません"
ElseIf ret = "False" Then
MsgBox "キャンセルボタンが押されました"
ElseIf ret = "0" Then
MsgBox "0が入力されました"
ElseIf IsNumeric(ret) = False Then
MsgBox "文字が入力されてします" & vbCrLf & ret
Else
MsgBox "数字です" & vbCrLf & ret
debug.print val(ret)

End If



End Sub

戻り値 Retを数字として受けるのではなく文字で受ければFalseも分かります。

こんな感じでは

Sub aaa()

Dim ret As String


ret = Application.InputBox("数字を入力下さい", , , , , , , 2)

If ret = "" Then
MsgBox "何も入力されていません"
ElseIf ret = "False" Then
MsgBox "キャンセルボタンが押されました"
ElseIf ret = "0" Then
MsgBox "0が入力されました"
ElseIf IsNumeric(ret) = False Then
MsgBox "文字が入力されてします" & vbCrLf & ret
Else
MsgBox "数字です" & vb...続きを読む

QInputBoxの入力値を半角数字のみと限定する方法

Excel_VBAで、InputBoxにより半角数字の入力を求めています。入力値が半角数字でない判定をするのに、最も容易な方法はありませんか?"CInt"だと文字列ではダメですし、悩んでおります。

InputBoxに、半角数字のみと限定するようなオプションがあれば良いのですが・・・。

Aベストアンサー

WinXP、IE6、Excel2003では以下のコードで動きました.
正規表現の意味はいろいろサイトをめぐってみてください.

Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = "^\d+$"
strVal = InputBox("何か入力して下さい.")
If regEx.Test(strVal) Then
MsgBox ("OK")
Else
MsgBox ("NG")
End If

QEXCELのVBAでのSelectとActivateの違い

VBAの初心者です。
ExcelのVBAでメッセージを表示してシートを切換えるというのを作りたいのです。
見真似で作成したのが↓です。


Dim rtn As String
rtn = MsgBox("シートを切換えますか", vbYesNo, "シートの切替")
If rtn = vbYes Then
Worksheets("送付先一覧").Activate
Range("a1").Select

Else
Exit Sub
End If

動作確認はできましたが、上記の「Activate」を「Select」に変更しても特に動作異常がありません。
そこで、疑問ですが、「Activate」と「Select」ってどうやって使い分けるのでしょうか?

Aベストアンサー

こんにちは。

通常は、シートもセルも Select でよいと思います。
選択して、扱えるようにするということだと思います。

#2さんも述べておりますが、Activate って、ひとつを選ぶことですね。でも、なぜか、Activate は、ほとんど使いません。

たぶん、Select は、選択した後に、その選択したものを、そのままオブジェクトとして確保して使えるので便利だから選ばれるのかもしれません。

Select → Selection
として使えます。

QEXCEL VBAで全選択範囲の解除

EXCEL VBAで
Cells.Select
と書くと、全セルが選択状態になりますが、
これを解除するには、どう書けばよいのでしょうか?

Aベストアンサー

その1
A1 など、適当なセルを選択する。
(回答#1と同じ)

その2
全選択する前の選択範囲に戻る。

全選択前に
変数 = Selection.Address で記憶

全選択後
Range(変数).Select で元の選択範囲を選択

QEXCEL VBAマクロ作成で、他のEXCELからデータを取り込みたい

メインプログラム(EXCEL VBA)より、
他のフォルダーにあるEXCELの項目の内容を取り込みたいです。
たとえば他のフォルダーのEXCELのRange("A2:A3").ValueをメインプログラムのRange("C2:C3").Valueにセットしたい時です。

・コマンドボタン押したら、どこのEXCELから取り込むかのポップアップ(?)は、表示はできてます。
・作業者が選んだパスとブックもMsgBoxで表示できてるので、もらう相手の場所も取得できてます。

・となると次はOPEN,INPUTですか?
テキストデータの取り込みですと、Inputでそのバッファを定義してるのですが、なんか違うような。。。

よろしくお願いします!

Aベストアンサー

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Cells(2, 2).Value ' 相手シートの B2 の値を自分自身の A1 に書き込む

readBook.Close False ' 相手ブックを閉じる
Set readSheet = Nothing
Set readBook = Nothing

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Ce...続きを読む

QエクセルVBAで違うブックの指定セルの値をコピーするコード

同じフォルダ内に次のブックがあります。
・「日報」フォルダ
・「入力」ブック
・「日報」ブック

「日報」ブックの「入力」シートのセルに入力して、ボタンを押すと
「日報」ブックの指定のセルに順にコピーしていくようにしたいの
ですが、コードをお教えいただけないでしょうか?
具体的には次のようになります。

「入力」ブックの「入力」シート→「日報」ブックの「日報」シート
A2,C2,D2,E2,F2→→→→→→A5,D5,F5,L5,P5
A3,C3,D3,E3,F3→→→→→→A6,D6,F6,L6,P6
A12,C12,D12,E12→→→→→→A34,J34,E34,E35
A13,C13,D13,E13→→→→→→A36,J36,E36,E37

このように入力されるようにしたいと思います。
実際にはもう少し同じようにコピーするところが
あるので、後でセル番地を追加できるようなコード
であれば非常にありがたいです。コードを教えて
ほしいなんて本当にずうずうしいですが、どうぞ
よろしくお願いします。

Aベストアンサー

#3です。直すのは簡単です。
マクロは日報ブックに、対比表も日報ブックのSheet2に作成としてください。
Sub test()
Dim sourceRange As Range
Dim destRange As Range
Dim sourceAddress As String
Dim destAddress As String
Dim addressTable As Range
Dim i As Long

Set addressTable = ThisWorkbook.Sheets("Sheet2").Range("A1").CurrentRegion
For i = 1 To addressTable.Rows.Count
sourceAddress = addressTable.Cells(i, 1).Value
destAddress = addressTable.Cells(i, 2).Value
Set sourceRange = Workbooks("入力.xls").Sheets("入力").Range(sourceAddress)
Set destRange = ThisWorkbook.Sheets("日報").Range(destAddress)
destRange.Value = sourceRange.Value
Next i
End Sub

#3です。直すのは簡単です。
マクロは日報ブックに、対比表も日報ブックのSheet2に作成としてください。
Sub test()
Dim sourceRange As Range
Dim destRange As Range
Dim sourceAddress As String
Dim destAddress As String
Dim addressTable As Range
Dim i As Long

Set addressTable = ThisWorkbook.Sheets("Sheet2").Range("A1").CurrentRegion
For i = 1 To addressTable.Rows.Count
sourceAddress = addressTable.Cells(i, 1).Value
d...続きを読む

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

QVB上で実行中の無限ループの止め方

今まで、CUIベースのBASICでのプログラムの経験はあるのですが
Visual系のBASICは初心者です。
原因はわかっているのでプログラムの修正はできるのですが
VB上でコンパイルして実行したときに無限ループに陥ってしまって
どうにもプログラムをとめられなくなります。
そんなことがないように、実行前に全てのプロジェクトを保存して
いますので、そんなに実害はないのですが、どうすればとめられるのでしょう・・
今現在は、タスクマネージャーから強制終了させています。

Aベストアンサー

無限ループの一番内側に
DoEvents
を入れておくと、ウィンドウ切替え->デバッガ終了操作が出来ますよ

危なそうなとこにも入れておくと、何かと安心です。

QSub ***( ) と Private Sub ***( ) の違い

初歩的な質問で申し訳ありませんが・・・

自分でコードを書いていても、イベントが発生したりした時の処理で、コードのウィンドウで上のドロップダウンリストで選択できる時の処理などは自動的に[Private Sub Command1_Click( )]などと出てくるのでそのまま使っています。自分で別途プロシージャーを作成する時は[Sub ****( )]としています。
ですがその違いを理解しないまま、自分で作成する時は[Private Sub]ではなくて[Sub]を使っています。

Sub ***( ) と Private Sub ***( ) の違いは何なんでしょうか?
どなたか説明頂けませんか?
よろしくお願いします。

Aベストアンサー

「Sub」の部分にカーソルを置いて[F1]を押せばヘルプが起動します。
「指定項目」のところに「Public」と「Private」の説明がありますよ。
省略して「Sub hogehoge()」とした場合は「Public」とみなされます。

Publicは「すべてのモジュールから呼び出せるプロシージャ」ということになります。
Privateとすると「同じモジュールの中からしか呼び出せないプロシージャ」となります。

もしExcelをお持ちでしたらExcelのVBEで標準モジュールを追加し、「Sub Test1()」と「Private Sub Test2()」を作成してみてください。
そしてExcelの[ツール]-[マクロ]-[マクロ(Alt+F8)]でマクロ実行のダイアログを表示させてみるとわかります。
ここには実行できるプロシージャの一覧が表示されますが、Test1は表示されているけれどTest2は表示されません。
Test1はPublicで、Test2はPrivateだからです。


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報