Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
64 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
【81213】Re:VBAのVlookupについて
発言  マナ  - 20/3/7(土) 19:36 -
引用なし
パスワード
   ▼as さん：

値のある範囲だけ SpecialCells(xlCellTypeConstants) を
For Each で、ループすることもできます。
また、複数セルを、まとめてVLookupできます。

Sub Main3()
　　Dim Serchkey As Range
　　Dim SerchRange As Range
　　Dim a As Range
　
　　Set Serchkey = Worksheets("書籍貸出表").Range("B3:B8")
　　Set SerchRange = Worksheets("書籍管理一覧表").Range("A3:B8")
　　Serchkey.Offset(, 1).ClearContents

　　For Each a In Serchkey.SpecialCells(xlCellTypeConstants).Areas
　　　　a.Offset(, 1).Value = Application.VLookup(a.Value, SerchRange, 2, False)
　　Next

End Sub
・ツリー全体表示
【81212】Re:VBAのVlookupについて
発言  as  - 20/3/7(土) 19:20 -
引用なし
パスワード
   変な空欄が入っておりエラーとなっていました。解決しました！ありがとうございました！
・ツリー全体表示
【81211】Re:VBAのVlookupについて
発言  マナ  - 20/3/7(土) 18:51 -
引用なし
パスワード
   ▼as さん：

>エラー9が発生しました。


ごめんなさい。シート名を実際のものに修正してください。
・ツリー全体表示
【81210】Re:VBAのVlookupについて
発言  as  - 20/3/7(土) 18:43 -
引用なし
パスワード
   度々すみません。

ご提示いただきました内容を実行しましたところ、エラー9が発生しました。

シート2のB3~B8に値をいれると、A3~A8に入ってる値にまっちした隣の値(B3~B8)をC3~C8に出力したいとう内容なのですが、このエラーが発生したということは、outputrangeの値がそもそも間違っているんでしょうか？
・ツリー全体表示
【81209】Re:VBAのVlookupについて
発言  マナ  - 20/3/7(土) 18:22 -
引用なし
パスワード
   ▼as さん：
>検索して見つからなかった場合は、エラーとして返したいです。


Application.VLookupを使います。

Sub Main2()
　　Dim Serchkey As Range
　　Dim SerchRange As Range
　　Dim OutputRange As Range
　　Dim i As Long
　　
　　Set Serchkey = Worksheets("1").Range("B3:B8")
　　Set SerchRange = Worksheets("2").Range("A3:B8")
　　Set OutputRange = Serchkey.Offset(, 1)
　　
　　Application.ScreenUpdating = False　'Flaseで画面更新停止、Trueで画面更新再開
　　
　　For i = 1 To Serchkey.Rows.Count
　　　　If Serchkey(i) <> "" Then
　　　　　　OutputRange(i) = Application.VLookup(Serchkey(i), SerchRange, 2, False)
　　　　End If
　　Next
　　Application.ScreenUpdating = True
　
End Sub
・ツリー全体表示
【81208】Re:VBAのVlookupについて
発言  as  - 20/3/7(土) 17:50 -
引用なし
パスワード
   検索して見つからなかった場合は、エラーとして返したいです。

そのため、書籍IDが空白の状態ではエラーを表示させず、書籍IDがなかった場合はエラーとして返したいです。
・ツリー全体表示
【81207】Re:VBAのVlookupについて
発言  マナ  - 20/3/7(土) 17:47 -
引用なし
パスワード
   ▼as さん：

では、検索して見つからないでエラーとなる場合は？
・ツリー全体表示
【81206】Re:VBAのVlookupについて
発言  as  - 20/3/7(土) 17:40 -
引用なし
パスワード
   >では、空白の場合は、どうしたいですか。

ご返信ありがとうございます。
空白の場合は、空白を文字列として「""」の状態を許可したいです。
・ツリー全体表示
【81205】Re:VBAのVlookupについて
発言  マナ  - 20/3/7(土) 15:12 -
引用なし
パスワード
   ▼as さん：
>空白をエラーと認識してしまいます。

では、空白の場合は、どうしたいですか。
・ツリー全体表示
【81204】VBAのVlookupについて
質問  as  - 20/3/7(土) 14:11 -
引用なし
パスワード
   空白をエラーと認識してしまいます。
お分かりになる方がいれば、ご教授いただけると幸いです。

現状は下記コードになります。

Sub Main()

　Dim Serchkey As Range
　Dim SerchRange As Range
　Dim OutputRange As Range
　Dim i As Long

　Set Serchkey = Worksheets("書籍貸出表").Range("B3:B8")　　　　
　Set SerchRange = Worksheets("書籍管理一覧表").Range("A3:B8")　
　Set OutputRange = Worksheets("書籍貸出表").Range("B3:C8")　　　

　Application.ScreenUpdating = False　'Flaseで画面更新停止、Trueで画面更新再開
　
　For i = 1 To Serchkey.Rows.Count
　 OutputRange(i, 2) = WorksheetFunction.Vlookup(Serchkey(i, 1), SerchRange, 2, False)
　Next
　Application.ScreenUpdating = True
　　
End Sub
・ツリー全体表示
【81203】Re:別ブックの同一シート全てにコピペし...
発言  マナ  - 20/3/6(金) 18:59 -
引用なし
パスワード
   ▼初心者 さん：

>ActiveWorkbookとThisWorkbookを上手く使い分けるといいのですね！

ブックやシートをアクティブにする必要はないです。
そうすれば、今より、コードも簡潔に書けるはずです。
・ツリー全体表示
【81202】Re:処理を中断
お礼  はるあき  - 20/3/6(金) 9:32 -
引用なし
パスワード
   助かりました、ありがとうございます！
・ツリー全体表示
【81201】Re:別ブックの同一シート全てにコピペし...
お礼  初心者  - 20/3/6(金) 0:05 -
引用なし
パスワード
   ▼マナ さん：
>▼［名前なし］ さん：
>
>>集約用のブックを作り、そちらにマクロを記述しています。
>
>その場合、集約用のブックは、ThisWorkbookなので、
>
>wsから、ThisWorkbook.Worksheets(ws.Name)へのコピーと考えるとよいです。

なるほどです！
ActiveWorkbookとThisWorkbookを上手く使い分けるといいのですね！
助かりました！ありがとうございます。
・ツリー全体表示
【81200】Re:処理を中断
発言  Jaka  - 20/3/5(木) 19:03 -
引用なし
パスワード
   ごめん、わすれてた。

>If namebox.Text = "" Then
>　　errst = "担当者名" + tmp & vblf
>end if

ここ以下
>If manbox.Text = "" Then
>　　errst = errst & "1万円札の枚数" + tmp & vblf
>end if

errst &
を忘れたました。
追加しておいてください。
・ツリー全体表示
【81199】Re:処理を中断
発言  Jaka  - 20/3/5(木) 18:49 -
引用なし
パスワード
   文字連結に+を使っているのか、足し算なのか解らんけど。
（尚、文字連結に+を使っている人を見ると、何考えているんだと思う方です。）

Dim errst as string

If datebox.Text = "" Then
　　errst = "日付" + tmp & vblf
end if

If namebox.Text = "" Then
　　errst = "担当者名" + tmp & vblf
end if

If manbox.Text = "" Then
　　errst = "1万円札の枚数" + tmp & vblf
end if

If gosenbox.Text = "" Then
　　errst = "5" + sen & vblf
end if

If nisenbox.Text = "" Then
　　errst = "2" + sen & vblf
end if

If senbox.Text = "" Then
　　errst = "1" + sen & vblf
end if

If gohyakubox.Text = "" Then
　　errst = "500" + hoka & vblf
end if

If hyakubox.Text = "" Then
　　errst = "100" + hoka & vblf
end if

If gojubox.Text = "" Then
　　errst = "50" + hoka & vblf
end if

If jubox.Text = "" Then
　　errst = "10" + hoka & vblf
end if

If gobox.Text = "" Then
　　errst = "5" + hoka & vblf
end if

If itibox.Text = "" Then
　　errst = "1" + hoka & vblf
End If

if errst <> "" then
　 msgbox left(errst,len(errst)-1), , "入力漏れ"
　 exit sub
end if
・ツリー全体表示
【81198】Re:処理を中断
発言  マナ  - 20/3/5(木) 18:47 -
引用なし
パスワード
   ▼はるあき さん：

こんな感じでもよいです。

Dim msg As String


ElseIf itibox.Text = "" Then
　　msg = "1" &　hoka
End if

If Len(msg) > 0 then
　　MsgBox msg, , "入力漏れ"
　　Exit Sub
End IF
・ツリー全体表示
【81197】Re:別ブックの同一シート全てにコピペし...
発言  マナ  - 20/3/5(木) 18:36 -
引用なし
パスワード
   ▼［名前なし］ さん：

>集約用のブックを作り、そちらにマクロを記述しています。

その場合、集約用のブックは、ThisWorkbookなので、

wsから、ThisWorkbook.Worksheets(ws.Name)へのコピーと考えるとよいです。
・ツリー全体表示
【81196】Re:処理を中断
発言  マナ  - 20/3/5(木) 18:29 -
引用なし
パスワード
   ▼はるあき さん：

Dim 入力済 As Boolean

のように変数を１個追加して
Falseの場合は、途中でExit Sub

ElseIf itibox.Text = "" Then
　　MsgBox "1" + hoka, , "入力漏れ"
Else
　　入力済 = True
End if

If 入力済 = False then Exit Sub
・ツリー全体表示
【81195】処理を中断
質問  はるあき  - 20/3/5(木) 13:30 -
引用なし
パスワード
   初めまして。
現在、練習でVBAを使って両替計算表を作ろうとしています。
入金フォームに必要事項を入力すると、"入金"テーブルにデータが追加されるような感じで作ろうと考えています。


そこで、データ入力を抜かすとIf文でメッセージボックスが出るように組んでみたのですが、メッセージ自体は表示されますが、その時点で入力している文がテーブルに追加されてしまいます。

If文で引っかかったら、残りのプログラムを実行しないようにしたいのですが、中々調べても出てこないので質問させていただきました。

もし、コードで改善出来る点もありましたら是非よろしくお願いします…


Private Sub registre_click()

　　tmp = "を入力してください。"
　　sen = "千円札の枚数" + tmp
　　hoka = "円の枚数" + tmp

　　If datebox.Text = "" Then
　　　　MsgBox "日付" + tmp, , "入力漏れ"
　　　　
　　ElseIf namebox.Text = "" Then
　　　　MsgBox "担当者名" + tmp, , "入力漏れ"
　　
　　ElseIf manbox.Text = "" Then
　　　　MsgBox "1万円札の枚数" + tmp, , "入力漏れ"
　　
　　ElseIf gosenbox.Text = "" Then
　　　　MsgBox "5" + sen, , "入力漏れ"
　　
　　ElseIf nisenbox.Text = "" Then
　　　　MsgBox "2" + sen, , "入力漏れ"
　　
　　ElseIf senbox.Text = "" Then
　　　　MsgBox "1" + sen, , "入力漏れ"
　　
　　ElseIf gohyakubox.Text = "" Then
　　　　MsgBox "500" + hoka, , "入力漏れ"
　　
　　ElseIf hyakubox.Text = "" Then
　　　　MsgBox "100" + hoka, , "入力漏れ"
　　
　　ElseIf gojubox.Text = "" Then
　　　　MsgBox "50" + hoka, , "入力漏れ"
　　
　　ElseIf jubox.Text = "" Then
　　　　MsgBox "10" + hoka, , "入力漏れ"
　　
　　ElseIf gobox.Text = "" Then
　　　　MsgBox "5" + hoka, , "入力漏れ"
　　
　　ElseIf itibox.Text = "" Then
　　　　MsgBox "1" + hoka, , "入力漏れ"
　　End If

　　Sheets("入金").Activate
　　
　　Dim ws As Worksheet
　　Dim tbl As ListObject
　　Dim N As Long
　　
　　Set ws = Worksheets("入金")
　　Set tbl = ws.ListObjects.Item("入金")
　　
　　　　With ws.ListObjects("入金")
　　　　　　.ShowTotals = False
　　　　End With
　　　　
　　　　With Range("E4").ListObject
　　　　N = .ListColumns(1).Range.Count
　　　　　　tbl.ListRows.Add
　　　　　　tbl.ListColumns(1).Range(N + 1) = N
　　　　　　tbl.ListColumns(2).Range(N + 1) = namebox.Text
　　　　　　tbl.ListColumns(3).Range(N + 1) = datebox.Text
　　　　　　tbl.ListColumns(4).Range(N + 1) = manbox.Text
　　　　　　tbl.ListColumns(5).Range(N + 1) = gosenbox.Text
　　　　　　tbl.ListColumns(6).Range(N + 1) = nisenbox.Text
　　　　　　tbl.ListColumns(7).Range(N + 1) = senbox.Text
　　　　　　tbl.ListColumns(8).Range(N + 1) = gohyakubox.Text
　　　　　　tbl.ListColumns(9).Range(N + 1) = hyakubox.Text
　　　　　　tbl.ListColumns(10).Range(N + 1) = gojubox.Text
　　　　　　tbl.ListColumns(11).Range(N + 1) = jubox.Text
　　　　　　tbl.ListColumns(12).Range(N + 1) = gobox.Text
　　　　　　tbl.ListColumns(13).Range(N + 1) = itibox.Text
　　　　End With
　　　　
　　　　With ws.ListObjects("入金")
　　　　　　.ShowTotals = True
　　　　End With
End Sub
・ツリー全体表示
【81194】Re:別ブックの同一シート全てにコピペし...
発言  ［名前なし］  - 20/3/5(木) 2:03 -
引用なし
パスワード
   ▼マナ さん：
>▼初心者です。 さん：
>
>マクロは、どのブックに記述していますか。

主任のブックと
グループ1のブック
グループ2のブック

上記3つを1つにまとめる為の
集約用のブックを作り、そちらにマクロを記述しています。
・ツリー全体表示
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
64 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free