ミスチルの大名曲の数々が配信決定!! 31日間無料!!【PR】

お世話になっております。
データベース上には情報を格納する必要はないのですが、毎回違ったり、入力しないときもある項目があります。
レポートで印刷するときに必要な場合だけ入力したいので
レポートのフォームに、テキストボックスコントロールソースを2つ設置し、それぞれ=InputBox("鍵の所在を入力してください")と、=InputBox("担当者名を入力してください")を入力しています。

フォームの印刷ボタンをクリックすると、入力ダイアログが表示され印刷プレビューで開くように埋め込みマクロを設定しています。inputboxをそれぞれ入力し、いざリボンの印刷をクリックするともう一度入力ダイアログが現れ、再度テキストボックスへの入力を求められます。

入力は最初に印刷プレビューで表示される前のみにしたいのですが、このやり方だと2回ずつ入力を要求されることになってしまい手間です。
何か他に方法はありますでしょうか??

A 回答 (1件)

InputBoxは使わずにクエリのパラメーターの入力を利用する。



レポートのレコードソースのクエリのフィールドに
担当者名: [担当者名を入力してください]
とすればレポートを開いたときにパラメーターの入力が出ます。

https://support.office.com/ja-jp/article/%E3%82% …
    • good
    • 0
この回答へのお礼

ありがとうございます!
Inputboxに固執しすぎて考え付きませんでした。
無事にレポートを作ることができました。
ベストアンサーに選ばせていただきます!

お礼日時:2017/07/11 12:49

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

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

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

QAccessのクエリについて

Accessのクエリでちょっと困っているのでお知恵をお借りしたいです。
例)
「属性データ」「回答結果」それぞれのデータを1つにまとめたい
双方のデータには、個人コードが付与されており、それをkeyにして
データをまとめたいのですが、
「属性データ」はあって「回答結果」が無い人は、
「属性データ」のみを出力して、「回答結果」の部分は空白にしたい
というような処理をする場合は、どうすれば良いのでしょうか。
処理を実行しようとすると
「あいまいな外部結合が含まれている」というエラーがでてしまいます・・・

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

Aベストアンサー

「属性データ」列を持つ側のテーブルを基準にして「回答結果」列を持つテーブルを結合してやれば問題ないかと思いますが、それ以上のテーブルを結合しているのでしょうか?

SELECT [Tbl-A].個人コード, [Tbl-A].属性データ, [Tbl-B].回答結果
FROM [Tbl-A] LEFT JOIN [Tbl-B] ON [Tbl-A].個人コード = [Tbl-B].個人コード;

あいまいな外部結合のエラーが出るという事は、そのクエリーを実行しようとするときに Access がどの順番に内部処理を行えばよいか迷ってしまうからです。
「どの順番か迷う」ということは結合の数が 2つ以上あり、結合の方向が合っていないという事が原因ではないかと想像できます。。
https://support.office.com/ja-jp/article/-c36948dc-c481-48c6-809d-38427e9ffdd7

QACCESS vbaでレポート名の変更をプログラムでできるんでしょうか?

ACCESS vbaでレポート名の変更をプログラムでできるんでしょうか?

Aベストアンサー

DoCmd.rename "Old Report Name", acReport, "New Report Name"
で行けるんじゃないかな? 
https://msdn.microsoft.com/en-us/library/office/ff823209.aspx
docmdをvbaと呼ぶかどうかは、よくわからないけど、
そういう意味でのVBAなら、ADOXでも可能だと思う。

QSQL文で パラメータが少なすぎます エラー

Access2016 のVBAについて教えてください。
例えば以下のようなテーブルがあるとします

Tテーブル(各フィールドは全てテキスト型)
│ 伝票 │  日付  │ 商品 │ 備考 │
  D001  2017/06/15  商品A  備考A
  D002  2017/07/02  商品B  備考B
  D003  2017/05/30  商品C  備考C
  D004  2017/07/19  商品D  備考D
  D005  2017/07/10  商品E  備考E

Tテーブルの日付フィールドから年月を取り出して(例 D002 ならば ”201707”)、
年月が201707のレコードを抽出するようなSQL構文を記述してみました。
-------------------
mySQL = "SELECT 伝票, 日付, 商品, (Left(日付,4) & Mid(日付,6,2)) AS 年月 FROM Tテーブル "
mySQL = mySQL & "WHERE 年月='201707';"

Set DB = CurrentDb
Set RS = DB.OpenRecordset(mySQL, dbOpenSnapshot)

RS.MoveFirst
Do Until RS.EOF
Debug.Print RS!伝票 & " " & RS!日付 & " " & RS!商品 & " " & RS!年月
RS.MoveNext
Loop
-----------------

ここで1行目のSQL構文までではうまくレコードセットができたのですが、
2行目の WHERE ~ を追記すると以下のエラーとなってしまいます。

実行時エラー ’3061’
パラメーターが少なすぎます。1を指定してください

このエラーを無くすためには、どのようにすればよいのでしょうか?
よろしくお願いいたします。

Access2016 のVBAについて教えてください。
例えば以下のようなテーブルがあるとします

Tテーブル(各フィールドは全てテキスト型)
│ 伝票 │  日付  │ 商品 │ 備考 │
  D001  2017/06/15  商品A  備考A
  D002  2017/07/02  商品B  備考B
  D003  2017/05/30  商品C  備考C
  D004  2017/07/19  商品D  備考D
  D005  2017/07/10  商品E  備考E

Tテーブルの日付フィールドから年月を取り出して(例 D002 ならば ”201707”)、
年月が201707のレコード...続きを読む

Aベストアンサー

WHERE句では列別名が使用できません。決まり事です。
シコシコ書いてください。

Qエクセルのバージョンアップによるマクロ不調

エクセル2007にて、for...next構文を含むマクロをフォームボタンに登録し使用していました。
カウンタ変数に3から25を代入しています。
(3行目から25行目を処理するため)

しかしエクセル2016にパソコンが変わり、ボタンを押すと3行目だけ処理しマクロが終わってしまいます。
ボタンを押す代わりに、VBEから直接実行すると問題なく最後まで繰り返し処理されます。

バージョンアップにより何か不都合があるのでしょうか。お教え下さい。

Aベストアンサー

#2の回答者です。
長文でまとまっていませんが、私の考えたレポートです。

こちらは、Excel 2013ですが、一応、通して動かしてみて完結はするのですが、途中、何か良くわからない動きがあります。このコードには、どちらかというと「気になる」の部分はあります。しかし、それ以上に、ハングしたかなって思わせるような状態で、マクロが終了しているのです。それが何か今のところは分かりません。
どうも、ステップで進める分には、まったくその問題はみられません。

そのコードで問題になる部分は、2つですが、結論からすると、直しても変わりませんでした。
> Dim h As Integer 'データ集積シートの最終行
これは、Integer ではなくて、Long 型のほうがよいです。
ついでに、Dim i As Long '入力表シートの行数 もLong型のほうがよいのは、PCの扱うデータは、32bit が主なので、Integer 型は、一旦、Long型に変換しているので、なるべく、Integer 型は使わないほうがよいとしています。

>h = Worksheets("集積_税制").Range("A65536").End(xlUp).Row + 1
これは、最初、ループの外で行って、書き込みが完了したら、
h = h+1

とします。ただ、それでも、問題はほとんど改善されませんでした。
ふつうは、マクロが抜けるという現象からしても、私の試した感じでは、どうやらメモリリークの現象に似ています。アンタッチャブルな部分に触れると、マクロは急停止してしまいます。

なお、Select Case  [値]  ←ここの値は、文字列でも数値でも構わないです。ただ、コードを見る限りは、数値になっているようですので、それ自体は問題なかろうと思います。

ボタンは、フォームオブジェクトのボタンをお使いになっているものだとは思いますが、ActiveX ですと、そのコードですと、少し問題が出る可能性はあります。

それで、私なりの書き方でコードを書いてみましたので、そちらで診ていただけませんか?

'// 基本的には、標準モジュールです。
Sub Integrated_Taxes()
 Dim i As Long '入力表シートの行数
 Dim h As Long 'データ集積シートの最終行
 Dim j As Long '新しく加えた変数
 Dim acSh As Worksheet '現在の表
 Dim iTaxSh As Worksheet
 '***設定****
 Set acSh = ActiveSheet 'このシートは「入力表_税制」か?
 Set iTaxSh = Worksheets("集積_税制")
 
 Application.ScreenUpdating = False
 h = iTaxSh.Cells(Rows.Count, 1).End(xlUp).Row + 1
 With acSh
  For i = 3 To 25 '入力表の入力可能行数
   If .Cells(i, 3).Value > 0 And .Cells(i, 3).Value < 4 Then
    j = .Cells(i, 3).Value + 3
    iTaxSh.Cells(h, 1).Resize(, 3).Value = .Cells(i, 7).Resize(, 3).Value
    iTaxSh.Cells(h, j).Value = .Cells(i, 10).Value
    h = h + 1
   End If
  Next i
 
 End With
 Application.ScreenUpdating = True
 
 iTaxSh.Select
 MsgBox "取り込みが終了しました!"
 Worksheets("入力表_税制").Select
 Range("B1").Select

End Sub
'//

以上です。

#2の回答者です。
長文でまとまっていませんが、私の考えたレポートです。

こちらは、Excel 2013ですが、一応、通して動かしてみて完結はするのですが、途中、何か良くわからない動きがあります。このコードには、どちらかというと「気になる」の部分はあります。しかし、それ以上に、ハングしたかなって思わせるような状態で、マクロが終了しているのです。それが何か今のところは分かりません。
どうも、ステップで進める分には、まったくその問題はみられません。

そのコードで問題になる部分は、2つですが...続きを読む

Qマクロの「SaveAs」でエラーが出るのを解消したいです

下記の↓↓↓↓↓↓部分でエラーが出ます。

「実行時エラー '1004':

'SaveAs' メソッドは失敗しました: '_Worksheet' オブジェクト」

ちょろちょろマクロ組んでたのですが単純な
エラーで解決が出来ない状態です。
どなたかマクロ先生に教えて頂ければと思いますので
よろしくお願いします。

'指定額の抽出
Private Const MESSAGE_FINISH = "予算出力処理が完了しました"

Sub 予算データテキスト出力()
Dim ws1
Set ws1 = Worksheets("チェック一覧")
Dim m As Long
m = 3
Dim ws2
Set ws2 = Worksheets("予算データ")

Dim sm As String

Dim ws3

Dim sn

'チェック一覧シートのNo.が無くなるまで処理する
Do Until ws1.Cells(m, 1) = ""

Application.ScreenUpdating = False


If ws1.Cells(m, 4) = "" Then
'ナンバーがある場合は部門等をチェック一覧(ws1)→フォーム(ws2)に転記する
Else
ws2.Cells(2, 2) = ws1.Cells(m, 4)

'各部署のシート名をsmにセットする
sm = ws1.Cells(m, 2)
Set ws3 = Worksheets(sm)

'予算フォーム(ws2)の行変数「s」と各部署シート(ws3)の行変数「n」
Dim s
s = 4
Dim n
n = 9
Dim cnt
cnt = 1

Do Until n = 44
If ws3.Cells(n, 23) = 0 Then

'各数値等を各部署のシート(ws3)→フォーム(ws2)に転記する
Else

ws2.Cells(s, 1) = cnt
ws2.Cells(s, 3) = 6100
ws2.Cells(s, 4) = 0
ws2.Cells(s, 5) = ws3.Cells(3, 4)
ws2.Cells(s, 6) = ws3.Cells(5, 8)

ws2.Cells(s, 7) = ws3.Cells(n, 4)
ws2.Cells(s, 8) = ws3.Cells(n, 24)
ws2.Cells(s, 9) = ws3.Cells(n, 25)
ws2.Cells(s, 10) = ws3.Cells(n, 26)
ws2.Cells(s, 11) = ws3.Cells(n, 27)
ws2.Cells(s, 12) = ws3.Cells(n, 28)
ws2.Cells(s, 13) = ws3.Cells(n, 29)
ws2.Cells(s, 14) = ws3.Cells(n, 31)
ws2.Cells(s, 15) = ws3.Cells(n, 32)
ws2.Cells(s, 16) = ws3.Cells(n, 33)
ws2.Cells(s, 17) = ws3.Cells(n, 34)
ws2.Cells(s, 18) = ws3.Cells(n, 35)
ws2.Cells(s, 19) = ws3.Cells(n, 36)
s = s + 1
cnt = cnt + 1

End If

n = n + 1

Loop
'予算データに転記されたので出力する

ws2.Copy

' ↓↓↓↓↓この下の「SaveAs」がエラーになります。↓↓↓↓↓

ActiveWorkbook.SaveAs Filename:="D:\Library\Desktop\新しいフォルダー\" & ws2.Cells(s, 5).Value & ".xlm"

ActiveWindow.Close

ActiveWorkbook.Close savechanges:=False


'フォームに転記した情報をクリア
ws2.Select
Range(Cells(4, 1), Cells(44, 19)).Select
Selection.ClearContents


End If

m = m + 1


Loop

ws1.Select

MsgBox MESSAGE_FINISH

End Sub

下記の↓↓↓↓↓↓部分でエラーが出ます。

「実行時エラー '1004':

'SaveAs' メソッドは失敗しました: '_Worksheet' オブジェクト」

ちょろちょろマクロ組んでたのですが単純な
エラーで解決が出来ない状態です。
どなたかマクロ先生に教えて頂ければと思いますので
よろしくお願いします。

'指定額の抽出
Private Const MESSAGE_FINISH = "予算出力処理が完了しました"

Sub 予算データテキスト出力()
Dim ws1
Set ws1 = Worksheets("チェック一覧")
Dim m As Long
m = 3
Dim ws2
Set ...続きを読む

Aベストアンサー

試していませんが、
ActiveWorkbook.SaveAs Filename:="D:\Library\Desktop\新しいフォルダー\" & ws2.Cells(s, 5).Value & ".xlm"

のファイルの拡張子は、".xlsm"が正しいかと。

Qサブクエリの使い方を教えて下さい。

下記のsqlをサブクエリーで記述したい。
SELECT Header.*
FROM Header
WHERE (((Header.from) Like "*YouTube*") AND ((Header.subject) Like "*イージス*"));

宜しく回答願います。

Aベストアンサー

答えを先にいうと「ifをネストするようなSQLはかけます」
(ただしくはサブクエリで絞り込んでから更に絞り込む)
ただしそれはやってはいけません。
「できる」と「やったほうがいい」は違います

SQLが速く検索できるのはインデックスを利用するからです
命題のようなサブクエリで一度絞り込むと、その先にインデックスはききません
結果としてサブクエリを使うと遅くなるだけです

Qアクセス2010 クエリが遅い 300万行ほどの1tblがあり、これだけで1.5GBくらい容量を食っ

アクセス2010 クエリが遅い

300万行ほどの1tblがあり、これだけで1.5GBくらい容量を食っています。
オートIDを振っています。
このテーブルを年月などを基準に分割して行数を減らさないとダメでしょうか?
よい方法がありましたら、教えてください。

Aベストアンサー

最適化はしてますよね。
で、クエリですが、300万のデータ全てに毎回計算させたら時間がかかるのは当たり前ですよね。
計算させるならその時必要なデータにのみするとか、工夫次第で処理は全然違います。
なんなら都度必要なデータのみをワークテーブルにしてもいいと思います。

Q元ある式にSUMで修正を加えたのですが、エラーが出てしまいました。何が良くなかったのでしょうか?

Wordに、Excelのワークシートを挿入しました。
それを、AとBの2組作りました。
そして、Aで出た計算結果をaとし、Bで出た計算結果をbとします。
最後に、a+bの計算結果をBに表示させるようにしました。

最初、a+bを求める式を、次のように設定し、上手く機能しました。

Aで使った式
=SUM(G5:G33)

Bで使った式
=SUM(G4:G8)+'[C Users taka Desktop パソコンで作成する簿記 帳簿 修繕積立金(1).docx の ワークシート]Sheet1'!$G$34

このまま終わっても良かったのですが、Aの計算結果は、Aの表示上では実際に必要としない部分なので、それをBに組み込んでしまおうと思い、次のように式を修正しました。

=SUM(G4:G8)+'[C Users taka Desktop パソコンで作成する簿記 帳簿 修繕積立金(1).docx の ワークシート]Sheet1'!SUM(G5:G33)

ところがこれで、エラーが出てしまいました。
何が良くなかったのでしょうか?

Wordに、Excelのワークシートを挿入しました。
それを、AとBの2組作りました。
そして、Aで出た計算結果をaとし、Bで出た計算結果をbとします。
最後に、a+bの計算結果をBに表示させるようにしました。

最初、a+bを求める式を、次のように設定し、上手く機能しました。

Aで使った式
=SUM(G5:G33)

Bで使った式
=SUM(G4:G8)+'[C Users taka Desktop パソコンで作成する簿記 帳簿 修繕積立金(1).docx の ワークシート]Sheet1'!$G$34

このまま終わっても良かったのですが、...続きを読む

Aベストアンサー

修正したものはSUM関数の使い方が間違っているために、エラーになるのです。
 =SUM(範囲)
なのですから、別ブックであっても同じことです。
 =SUM(G5:G33)
のG5:G33の部分を別ブックにするだけですね。
 =SUM(G4:G8)+SUM('[C Users taka Desktop パソコンで作成する簿記 帳簿 修繕積立金(1).docx の ワークシート]Sheet1'!G5:G33)

他のブックのセル範囲への外部参照 (リンク) を作成する
https://support.office.com/ja-jp/article/%E4%BB%96%E3%81%AE%E3%83%96%E3%83%83%E3%82%AF%E3%81%AE%E3%82%BB%E3%83%AB%E7%AF%84%E5%9B%B2%E3%81%B8%E3%81%AE%E5%A4%96%E9%83%A8%E5%8F%82%E7%85%A7-%E3%83%AA%E3%83%B3%E3%82%AF-%E3%82%92%E4%BD%9C%E6%88%90%E3%81%99%E3%82%8B-c98d1803-dd75-4668-ac6a-d7cca2a9b95f

修正したものはSUM関数の使い方が間違っているために、エラーになるのです。
 =SUM(範囲)
なのですから、別ブックであっても同じことです。
 =SUM(G5:G33)
のG5:G33の部分を別ブックにするだけですね。
 =SUM(G4:G8)+SUM('[C Users taka Desktop パソコンで作成する簿記 帳簿 修繕積立金(1).docx の ワークシート]Sheet1'!G5:G33)

他のブックのセル範囲への外部参照 (リンク) を作成する
https://support.office.com/ja-jp/article/%E4%BB%96%E3%81%AE%E3%83%96%E3%83%83%E3%82%AF%E3%81%AE%E3%82%BB%E3%83%A...続きを読む

Qクエリをエクセルファイルへの出力

保存先を任意に選択して、クエリをエクセルファイルで出力したく、見よう見まねで以下のモジュールを作成しました。

ホームページのサンプルだと「xls」のところが、「CSV」になっていたので、今回、「xls」に直しました。

これを、実行すると「データベースまたはオブジェクトは読み取り専用なので、更新できません」の
メッセージが出力します。

「xls」を「CSV」に戻すと、正常にCSVファイルが出力できます。

原因が分かりません。どなたか助けてください。



Public Function GetFileName() As String

Const ENABLE_WIZHOOK = 51488399
Const DISABLE_WIZHOOK = 0

Dim CurrentPath As String: CurrentPath = Application.CurrentProject.Path
Dim StrFile As String: StrFile = "ベンチマーク_" & Format(Date, "yyyymmdd") & ".xls" ' 選択するファイルの絶対パス格納用
Dim myFilter As String: myFilter = "xlsファイル(*.xls)|*.xls" ' 選択可能ファイルのフィルタ

WizHook.Key = ENABLE_WIZHOOK

INTREXULT = WizHook.GetFileName(0, "", "", "", StrFile, CurrentPath, myFilter, 0, 0, 0, OpenOrSaveFlg)
If INTREXULT <> 0 Then '「ファイルを保存」ダイアログで[キャンセル]を押下した場合
GetFileName = ""
Exit Function
End If
WizHook.Key = DISABLE_WIZHOOK
GetFileName = StrFile

End Function

保存先を任意に選択して、クエリをエクセルファイルで出力したく、見よう見まねで以下のモジュールを作成しました。

ホームページのサンプルだと「xls」のところが、「CSV」になっていたので、今回、「xls」に直しました。

これを、実行すると「データベースまたはオブジェクトは読み取り専用なので、更新できません」の
メッセージが出力します。

「xls」を「CSV」に戻すと、正常にCSVファイルが出力できます。

原因が分かりません。どなたか助けてください。



Public Function G...続きを読む

Aベストアンサー

マクロを下記の様に作ります。

1. クエリを開く
クエリ名は、Excelに出力するクエリの名前を指定する
ビューは、データシートビューを指定する
データモードは編集を指定する。

2. コマンドの実行
Excelに出力を指定する。

これを実行すると、新規のExcelが開きます。ここに、クエリの内容が
入ります。ここから、先の操作はExcelの通常の操作になります。

これで、ユーザーに保存をさせるのが良いのではないでしょうか。
マクロとしては、単に上記に書いた様に2つのステップだけです。

やって見て下さい。

QVBA コンパイルエラーの解消法

皆様、いつもお世話になっております。
初心者なりに考えてVBAを組んでみたのですが、「Sub または Fanction が定義されていません」とエラー表示が出てきます。
自分なりにコードに間違いがないか検索ながらやってみたのですが、うまくいきません。

どなたか、知恵をお貸しいただけないでしょうか。



テーブルの入っているSheet1から、シート”施工体制台帳~”の該当するセルにデータのコピーを行うためのVBAです。
業者の数だけループするように組んだつもりなのですが、エラー表示のため実行ができません。
ご指摘、よろしくお願いいたします。

Sub kopipe1() '施工体制台帳
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim sb As Long
Dim m As Long
Dim p As Long
Dim c As Long
Dim i As Long
Dim end1 As Long

Set sh = Worksheet("sheet1")
Set sh1 = Worksheet("施工体制台帳 (下請け) ")


end1 = sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
sb = 1
p = 1

For i = 2 To end1 Step 1
sb = sb + 1
c = cell(p, 9)

sh.cell(sb, 2).Copy Destination:=.sh1.Range(c).Offset(2, 1) '会社名
sh.cell(sb, 3).Copy Destination:=.sh1.Range(c).Offset(2, 27) '代表者名
sh.cell(sb, 4).Copy Destination:=.sh1.Range(c).Offset(4, 1) '郵便番号
sh.cell(sb, 5).Copy Destination:=.sh1.Range(c).Offset(5, 1) '住所
sh.cell(sb, 6).Copy Destination:=.sh1.Range(c).Offset(6, 24) '電話番号
sh.cell(sb, 7).Copy Destination:=.sh1.Range(c).Offset(13) '業種1
sh.cell(sb, 8).Copy Destination:=.sh1.Range(c).Offset(14, 12) '許可者1
sh.cell(sb, 9).Copy Destination:=.sh1.Range(c).Offset(14, 15) '区分1
sh.cell(sb, 10).Copy Destination:=.sh1.Range(c).Offset(14, 17) '許可1-1
sh.cell(sb, 11).Copy Destination:=.sh1.Range(c).Offset(14, 20) '許可1-2
sh.cell(sb, 12).Copy Destination:=.sh1.Range(c).Offset(14, 27) '許可年月日
sh.cell(sb, 13).Copy Destination:=.sh1.Range(c).Offset(16) '業種2
sh.cell(sb, 14).Copy Destination:=.sh1.Range(c).Offset(17, 12) '許可者2
sh.cell(sb, 15).Copy Destination:=.sh1.Range(c).Offset(17, 15) '区分2
sh.cell(sb, 16).Copy Destination:=.sh1.Range(c).Offset(17, 17) '許可2-1
sh.cell(sb, 17).Copy Destination:=.sh1.Range(c).Offset(17, 20) '許可2-2
sh.cell(sb, 18).Copy Destination:=.sh1.Range(c).Offset(17, 27) '許可年月日2
sh.cell(sb, 19).Copy Destination:=.sh1.Range(c).Offset(21, 28) '健康保険
sh.cell(sb, 20).Copy Destination:=.sh1.Range(c).Offset(22, 28) '厚生年金保険
sh.cell(sb, 21).Copy Destination:=.sh1.Range(c).Offset(23, 28) '雇用保険
sh.cell(sb, 22).Copy Destination:=.sh1.Range(c).Offset(25, 3) '現場代理人指名
sh.cell(sb, 23).Copy Destination:=.sh1.Range(c).Offset(29, 7) '主任技術者氏名
sh.cell(sb, 24).Copy Destination:=.sh1.Range(c).Offset(31, 3) '資格内容
sh.cell(sb, 25).Copy Destination:=.sh1.Range(c).Offset(33, 3) '安全衛生責任者
sh.cell(sb, 26).Copy Destination:=.sh1.Range(c).Offset(25, 26) '安全衛生推進者
sh.cell(sb, 27).Copy Destination:=.sh1.Range(c).Offset(27, 26) '雇用管理責任者
sh.cell(sb, 28).Copy Destination:=.sh1.Range(c).Offset(29, 26) '専門技術者名
sh.cell(sb, 29).Copy Destination:=.sh1.Range(c).Offset(31, 26) '技術資格内容

p = p + 62
Exit For
Next i
End Sub

皆様、いつもお世話になっております。
初心者なりに考えてVBAを組んでみたのですが、「Sub または Fanction が定義されていません」とエラー表示が出てきます。
自分なりにコードに間違いがないか検索ながらやってみたのですが、うまくいきません。

どなたか、知恵をお貸しいただけないでしょうか。



テーブルの入っているSheet1から、シート”施工体制台帳~”の該当するセルにデータのコピーを行うためのVBAです。
業者の数だけループするように組んだつもりなのですが、エラー表示...続きを読む

Aベストアンサー

今のところ、変数に代入する以外のコードはほとんど間違っているわけですから、どれがどうと言えないと思います。
他の方との重複を含みます。
・Worksheet(---) ->Worksheets(----)
・sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
  ↓
sh.Cells(Rows.Count, 2).End(xlUp).Row
・c = cell(p, 9)
  ↓
 c = Cells(p, 9) ただし、最後に、p = p + 62の後、Exit For では、1回キリでおしまいになってしまいます。

おそらくは、Dim c As String --Cells(p, 9).Address(0,0)
のはずです。
 
・sh.cell(sb, 2).Copy Destination:=.sh1.Range(c).Offset(2, 1) '会社名
とりあえず、Cells と sh1 のコンマは取るけれども、
sh1.Range(c).Offset(2, 1) これでは可読性を落とすばかりで分かりません。

これ自体を直すよりは、最初から作り直したほうが早そうです。
たぶん、一覧で横に並んでいるものを、別のシートの各場所に振り替えていくわけで、それが、ページごとになっているというわけでしょう。

まず、 sh1.cells(sb, 2).Copy ですが、
その列の2 を変数にすべきですね。

受ける側が、Offset で書かれてしまうと、手がつけられなくなってしまいます。

sh1.Range("J3,AJ3,J5,J6,AG7,I14,U15,X15,Z15,AC15,AJ15,I17," & _
 "U18,X18,Z18,AC18,AJ18,AK22,AK23,AK24,L26,P30,L32,L34," & _
 "AI26,AI28,AI30,AI32")

このようにまとめてしまい、以下のように纏めたものから呼び出すようにします。
しかし、実際にやってみると不具合が生じるので、それを配列で渡すようにします。

注:以下は、私の想像で書かれたものであって、実際に合っているのかは分かりません。
このようなスタイルにしてみたらという、あくでもこちらの提案です。

'//
Sub Test1()
 Dim Rng As Range
 Dim i As Long, j As Long, sb As Long
 Dim c As Variant
 Dim sh As Worksheet, sh1 As Worksheet
 Set sh = Worksheets("sheet1")
 Set sh1 = Worksheets("施工体制台帳 (下請け)")

 
 Set Rng = sh1.Range("J3,AJ3,J5,J6,AG7,I14,U15,X15,Z15,AC15,AJ15,I17," & _
 "U18,X18,Z18,AC18,AJ18,AK22,AK23,AK24,L26,P30,L32,L34," & _
 "AI26,AI28,AI30,AI32")
 
 end1 = sh.Cells(Rows.Count, 2).End(xlUp).row
 
 i = 2
 sb = 2
 For j = 1 To end1
 a = (j - 1) * 62 + 1
  For Each c In Rng.Offset((j - 1) * 62 + 1)
   c.Value = sh.Cells(sb, i).Value
   DoEvents
   i = i + 1
  Next
  i = 2
  sb = sb + 1
 Next
End Sub

今のところ、変数に代入する以外のコードはほとんど間違っているわけですから、どれがどうと言えないと思います。
他の方との重複を含みます。
・Worksheet(---) ->Worksheets(----)
・sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
  ↓
sh.Cells(Rows.Count, 2).End(xlUp).Row
・c = cell(p, 9)
  ↓
 c = Cells(p, 9) ただし、最後に、p = p + 62の後、Exit For では、1回キリでおしまいになってしまいます。

おそらくは、Dim c As String --Cells(p, 9).Address(0,0)
のはずです。
 
・sh.cell(sb, 2).C...続きを読む


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

人気Q&Aランキング