エクセルVBAで配列の書き方とセルへの一括表示方法

このQ&Aのポイント
  • エクセルVBAで配列を使い、セルへの一括表示方法を学びたいです。
  • 初めてのVBAで、エクセルの配列の書き方やセルへの一括表示方法がわかりません。
  • タイトル行からE列が空白になるまで、E列~H列の値を変数に入れて、別の列・行に一括で表示・書き込みたいです。どうすればよいですか?
回答を見る
  • ベストアンサー

エクセルVBA 配列の書き方とセルへの一括表示方法

エクセルのVBAで 下記のようなプログラムを作成しています。 1行目はタイトル行で E列が空白になるまで、 各行のE列~H列の値を変数に入れて、 最後に一括で別の列・行にそれぞれの値を表示・書込したいと思ってますが、 どうもVBAは初めてでよくわかりません。 Dim aaa As String Dim bbb As String Dim ccc As String Dim eee As Double intRow = 2 Do Until Cells(intRow, 5).Value = "" aaa = Cells(intRow, 5).Value) bbb = Cells(intRow, 6).Value) ccc = Cells(intRow, 7).Value) ddd = Cells(intRow, 8).Value) intRow = intRow + 1 Loop aaaの各変数を2行目のA1~intRowまで bbbの各変数を2行目のB1~intRowまで cccの各変数を2行目のC1~intRowまで dddの各変数を2行目のD1~intRowまで セルに一括して表示したいのです。 配列の書き方と、セルの範囲に表示・書込する方法を どうかご教示下さい。お願いいたします。

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

  • ベストアンサー
  • eden3616
  • ベストアンサー率65% (267/405)
回答No.4

>できましたら、loopした場合に配列をどのように入れて、 >最終的に、指定した列の2行目から値が入っている最大行(空白行)までの間に >配列を放り込む方法を教えて頂けたらと思います。 先ほどの回答では味気ないため、「Sample3」において具体的に作成しました。 データの数が変動するかと思います。大きな配列を用意してもいいのですが、 ループ内で配列のサイズをReDimで広げています。 ReDimのPreserveで広げれる要素は多次元配列の最後の次元だけですので、 仮に1次元目に列、2次元目に行を格納する配列変数myDataを用意して 加工したデータをDo~Loop内で拡張しながら格納していきます。 ループを抜けたら、ワークシート関数の「Transpose」にて行列を入れ替えて 出力用の配列変数outDataに再度格納します。 これで1、2次元の要素数が入れ替わりますので、outData(行,列)として セル範囲に書出すことが出来ます。 書出し先のセルは変数tarColにて列記号を指定することで データの開始行番号と組み合わせたCells(intRow,tarCol)を基準セルとして Resizeで配列の大きさにセル範囲を拡張し、配列outDataを書出しています。 >原因は私のプログラムにあるかとは思いますが、 >なぜか、デバッグ実行時には、きちんと値が入るセルが >通常実行ではなぜか値が入らない場合があるためです。 >ネットに接続して値を取得している為、 >処理が重いのかどうなのかはわからないのですが。 aaa~dddの変数に加工した内容が正しくセットされているかは 本件とは異なる質問かと思いますので、デバックにて確認ください。 ■VBAコード Sub Sumple3() Dim intRow As Long, cnt As Long, tarCol As String Dim aaa As String, bbb As String, ccc As String, ddd As String Dim myData() As String, outData() As Variant '配列初期化 ReDim myData(0, 0) '開始行番号指定 intRow = 2 '出力列指定 tarCol = "A" 'データ取得及び配列格納 Do Until Cells(intRow + cnt, 5).Value = ""   '配列の要素数加算   If cnt > 0 Then     ReDim Preserve myData(0, UBound(myData, 2) + 1)   End If   'データの取得   aaa = Cells(intRow + cnt, 5).Value   bbb = Cells(intRow + cnt, 6).Value   ccc = Cells(intRow + cnt, 7).Value   ddd = Cells(intRow + cnt, 8).Value   'データの加工及び配列格納   myData(0, cnt) = aaa & "-" & bbb & "-" & ccc & "-" & ddd   'カウントアップ   cnt = cnt + 1 Loop '配列の行列入替 outData = Application.WorksheetFunction.Transpose(myData) '配列をセル範囲に出力 Cells(intRow, tarCol).Resize(UBound(outData, 1), UBound(outData, 2)) = outData End Sub

boooone
質問者

補足

素晴らしく丁寧な回答ありがとうございます。 よく理解出来ました。 初めてVBAを使いましたが、すごく便利そうでこれからも活用していこうかなと思います。 ありがとうございました。

その他の回答 (3)

  • eden3616
  • ベストアンサー率65% (267/405)
回答No.3

配列に格納後セル範囲を指定して配列変数を指定することで書き出すことが出来ます。 事前に用意した配列変数myDataに個々に格納する場合は以下のようになります。 (書出すセル範囲の数と配列の数は一致させてください) 以下のコードでは1行4列のデータ(セル範囲E2:H2)を・・・  Sample1は4行1列(A4:A7)に書き出し、  Sample2は1行4列(A4:D4)に書き出し しています。 ■VBAコード Sub Sumple1() Dim myData(3, 0) As String Dim intRow As Long Dim i As Long   '配列に値を格納   intRow = 2   myData(0, 0) = Cells(intRow, 5).Value   myData(1, 0) = Cells(intRow, 6).Value   myData(2, 0) = Cells(intRow, 7).Value   myData(3, 0) = Cells(intRow, 8).Value   'ここに配列に対する処理を記述   For i = 0 To 3     myData(i, 0) = myData(i, 0) & "セルの処理結果"   Next i   '(A4セルから、3+1行・0+1列に拡張したセル範囲に配列を)書き出し   Range("A4").Resize(UBound(myData, 1) + 1, UBound(myData, 2) + 1) = myData End Sub Sub Sumple2() Dim myData(0, 3) As String Dim intRow As Long Dim i As Long   '配列に値を格納   intRow = 2   myData(0, 0) = Cells(intRow, 5).Value   myData(0, 1) = Cells(intRow, 6).Value   myData(0, 2) = Cells(intRow, 7).Value   myData(0, 3) = Cells(intRow, 8).Value   'ここに配列に対する処理を記述   For i = 0 To 3     myData(0, i) = myData(0, i) & "セルの処理結果"   Next i   '(A4セルから、0+1行・3+1列に拡張したセル範囲に配列を)書き出し   Range("A4").Resize(UBound(myData, 1) + 1, UBound(myData, 2) + 1) = myData End Sub

boooone
質問者

お礼

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

  • eden3616
  • ベストアンサー率65% (267/405)
回答No.2

添付画像のようなA1セルからC10セルの範囲を配列変数に格納し、 E5セルからG14セルに書出しています。 Sub sumple() Dim myData As Variant   'A1:C10を配列変数myDataに格納   myData = Range("A1:C10")   'D1セルを左上として、10行・3列のセル範囲にmyDataを書出し   Range("E5").Resize(UBound(myData, 1), UBound(myData, 2)) = myData End Sub また、セル書き出しの処理において作画で処理に時間がかかる場合があります。 大量のデータであれば上記のように配列に格納して一括で書き出すほうが早いんですが、 多少(数千程度)のデータであれば個々にループで書き出しても良いかと思います。 その際にかかる時間については、以下のコードで一時的に作画を停止し 再度処理の後に作画してあげれば高速化できます。 '作画の停止 Application.ScreenUpdating = False 'Do ~ Loop または For~Next による繰り返し処理 '作画の再開 Application.ScreenUpdating = True 数式が大量に有るシートですと計算式が更新される時間も停止させる 以下の処理も組み合わせると良いかと思います。 '自動計算OFF Application.Calculation = xlCalculationManual '自動計算ON Application.Calculation = xlCalculationAutomatic

boooone
質問者

補足

ご丁寧にありがとうございます。 aaaなどの変数には実際には編集した値が入るので intRow = 2 Do Until Cells(intRow, 5).Value = "" aaa = Cells(intRow, 5).Value)を元に編集した値が入ります bbb = Cells(intRow, 6).Value)を元に編集した値が入ります ccc = Cells(intRow, 7).Value)を元に編集した値が入ります ddd = Cells(intRow, 8).Value)を元に編集した値が入ります intRow = intRow + 1 Loop myData = Range("A1:C10") のようなパターンではなく、 できましたら、loopした場合に配列をどのように入れて、 最終的に、指定した列の2行目から値が入っている最大行(空白行)までの間に 配列を放り込む方法を教えて頂けたらと思います。 原因は私のプログラムにあるかとは思いますが、 なぜか、デバッグ実行時には、きちんと値が入るセルが 通常実行ではなぜか値が入らない場合があるためです。 ネットに接続して値を取得している為、 処理が重いのかどうなのかはわからないのですが。 作画の停止、再開は組み込んでみましたが、そんなに早さは変わらなくて。。 Application.ScreenUpdating = False/True 何卒宜しくお願い致します。

  • dogs_cats
  • ベストアンサー率38% (278/717)
回答No.1

>各行のE列~H列の値を変数に入れて、最後に一括で別の列・行にそれぞれの値を表示・書込したいと思ってます 変数に格納しなくても直接、入力したいセルにデータを記入する方法で良いのでは。 一例です。I列以降に同一データを入力する方法です。 (別のBOOkや別シートにを指定も可能です。) データをコピーしたいセル番地が記載されていないのでここまでしか記載出来ません。 全データを変数に格納した後にデータを入力したいのでしたら変数を一次配列又は2次配列で宣言して格納する必要があります。 Sub test() Dim introw As Integer introw = 2 Do Until Cells(introw, 5).Value = "" Cells(introw, 10).Value = Cells(introw, 5).Value Cells(introw, 11).Value = Cells(introw, 6).Value Cells(introw, 12).Value = Cells(introw, 7).Value Cells(introw, 13).Value = Cells(introw, 8).Value introw = introw + 1 Loop End Sub

boooone
質問者

お礼

ご回答頂きありがとうございました。

boooone
質問者

補足

ご回答有難うございます。 >変数に格納しなくても直接、入力したいセルにデータを記入する方法で良いのでは。 上記方法を試しましたが、内部でいろいろやっている為に、処理(表示)として遅かったので、変数に一旦入れて、一括で表示できたらという希望です。 >変数を一次配列又は2次配列で宣言して格納する必要があります。 というところと、一括で配列からセルへの表示仕方をご教示お願いできればと思います。 何度も申し訳ございませんが、宜しくお願い致します。

関連するQ&A

  • 【エクセル】空セルを埋める方法

    お世話になります。 下記のような表があります。 1行目:AAA,BBB,CCC,DDD 2行目:空セル,BBB,CCC,DDD 3行目:空セル,BBB,CCC,DDD 4行目:aaa,BBB,CCC,DDD 5行目:空セル,BBB,CCC,DDD ・・・ こんなパターンの行が結構あります。 空セル部分を下記のように埋めたいのですが 1行目:AAA,BBB,CCC,DDD 2行目:AAA,BBB,CCC,DDD 3行目:AAA,BBB,CCC,DDD 4行目:aaa,BBB,CCC,DDD 5行目:aaa,BBB,CCC,DDD てっとり早く埋める方法ありませんか? いまは、【ctrl+↓】 ⇒【↑】⇒【ctrl+D】を延々繰り返しています。 宜しくお願いいたします。

  • VBAの正規表現

    VBAで正規表現による置換をしたいです。 以下のような行が複数あります。 1 aaa bbb ccc ddd 2 aaa bbb ccc ddd 3 aaa bbb ccce ddd 4 aaa bbb eccc ddd ccc の部分のみ置換したいです。 dim hensuu as string dim replace as string replace = eee hensuu = ccc (省略) strPattern = "(\s*)" & hensuu & "(\s+)" rep = RegExpObj.Replace(buf, "\1" & replace & "\2") 行数1,2 のみを置換したのですが、4も置換されてしまいます。 (\s*) の "*" が良くないのは理解していますが、"+" にしてもうまくいきません。 どなたかどのようにしたら1,2のみ置換できるようになるかをご教授お願いできませんでしょうか よろしくお願いいたします。

  • エクセルのマクロについて教えて下さい。

    エクセルのマクロについて教えて下さい。 Sub Ref() Dim ax As String Dim num As Integer, i As Integer Dim arr As Variant Dim tex As String Range("A1").Select ax = ActiveCell.Formula arr = Split(ax, ",") For i = 0 To UBound(arr) num = i + 1 Cells(num, 1).Value = arr(i) Next i For i = 1 To 10 ActiveCell.Offset(, 1).Select tex = ActiveCell.Formula Selection.Resize(num, 1).Select Selection.Formula = tex Selection.Resize(1, 1).Select Next i End Sub このマクロを10行ほどまで対応させたいです。 例として2行の表ですが、           A         B   C  D   E  F 1 C100,C101,C102,C103 aaa bbb ccc ddd eee 2 C104,C105,C106,C107 とうい表を、     A B  C  D   E   F 1 C100 aaa bbb ccc ddd eee 2 C101 aaa bbb ccc ddd eee 3 C102 aaa bbb ccc ddd eee 4 C103 aaa bbb ccc ddd eee 5 C104 aaa bbb ccc ddd eee 6 C105 aaa bbb ccc ddd eee 7 C106 aaa bbb ccc ddd eee 8 C107 aaa bbb ccc ddd eee という表にしたいです。 結合してから展開しようと考えたのですが 1列目の文字列の最後にカンマが無い場合、ある場合がありまして、 対応する事が出来ませんでした。 マクロ初心者なので教えてください。 よろしくお願いします。

  • Excel VBAでのテキスト出力について

    excel vbaでの文字列出力について エクセルからテキスト(メモ帳とか)に出力したいのですが 下記のように出力できなくて困っております。 どなたか教えてほしいです。 ●入力エクセル AAA BBB CCC DDD EEE セル(1,1)~(1,5)にそれぞれ文字列が入っている状況です。 これを下記のように出力したいのです。 ●テキスト出力 "AAA","BBB",CCC,"DDD",EEE CCCとEEEをダブルクォーテーションを付けないで出力したいのです。 出力の方法でwriteとprintがありますが writeで Write #1, Cells(1,1),Cells(1,2),Cells(1,3),Cells(1,4),Cells(1,5) やると、自動で全ての文字がダブルクォーテーションで囲まれて、カンマが自動でつき "AAA","BBB","CCC","DDD","EEE" のようになってしまします。CCCとEEEのダブルクォーテーションが不要です。 printで Print #1, CStr(Cells(1,1)), & "," CStr(Cells(1,2)), & "," Cells(1,3), & "," CStr(Cells(1,4)), & "," Cells(1,5) とすると "AAA", "BBB", CCC, "DDD", EEE となり、カンマの後ろに空白が何個か入った状態になります。 (ブラウザでは空白が分かりづらいですが、テキストですと入っております。) Trim関数でTrim(",")とか色々試しましたが上手くいきません。 どうしたら望み通りの出力ができるでしょうか。 ぜひ教えて頂きたいです。 よろしくお願いします。

  • ExcelのVBA ListBox.RowSourceの範囲について教えてください。

    下記のように範囲を変数で検索指定したいのですが、うまくいきません。VBAは初心者です。誰か助けて。 内容は・・・五十音順にあるリストを作り、ウ音のみをListBoxに表示したいのですが。 Private Sub ToggleButton3_Click() Dim A As Range Dim BBB As String Dim C As Range Dim DDD As String Set A = Cells.Find(what:="ウ", lookat:=xlWhole) BBB = Cells(A.row, A.Column + 1).Address Set C = Cells.Find(what:="エ", lookat:=xlWhole) DDD = Cells(C.row - 1, C.Column + 1).Address ListBox商品名.RowSource = "BBB:DDD" End Sub PS 違う方法でもいいのでどなたか教えてください。

  • Excel VBA 起点からの複数行一括削除

    Excel VBAで末端までだと4万行くらいのデータを整理するものを組んで います。初心者ゆえどなたかお詳しい方の知恵を拝借いたしたく。 元となるデータは15行が一塊であるデータブロックで構成されており、 14行目には"END"の文字があり、15行目には必ず空白行があります。 この15行のデータブロックが延々4万行繰り返しの形で存在しています。 どのデータブロックか判別できる数字が入っているのは1行目のE列 です。 データブロック一行目E列に含まれる特定の語句(IDNo.)を検索し、これを 起点として空白行までの15行一塊のデータブロックをまとめて削除でき るものを作成しようと思ったのですが、一行ずつ削除するところまでしか 自力では分からず、これ以降どのように追記すれば良いか見当がつか ない状態です。よろしくお願いします。 元データ     A    B   C    D    E     F   G 1   aaa   bbb  ccc  ddd   (IDNo.)  fff  ggg 2   111  222  333  444   555   666  777 (略) 14 END 15 (空白行) 16  AAA  BBB  CCC DDD  (IDNo.) FFF GGG (略) 29 END 30 (空白行) 以下 検索したもの+自分で追記してみた部分です。 Sub 特定ID削除() With ActiveWorkbook.ActiveSheet Const startrow As String = "1" '開始行を指定 Const col As String = "E" '識別文字が入力されている列 Dim Idx As Long Dim keyWord keyWord = Application.InputBox("削除対象の文字列を指定", Type:=2) If TypeName(keyWord) <> "Boolean" And Len(keyWord) > 0 Then For Idx = .Cells(65536, col).End(xlUp).Row To startrow Step -1 If InStr(.Cells(Idx, col).Value, keyWord) > 0 Then ' If Application.CountIf(Rows(Idx), "*" & keyWord & "*") > 0 Then .Rows(Idx).Delete End If Next Idx End If End With End Sub

  • VBAにて計算式をセルへ代入できなくて困っています

    計算式を変数QRdataへ代入し その変数から指定のセルへ入力するとき、実行時エラー1004となってしまい マクロを実行できずに困っています。 Cells(3, 6).ValueもRange("F3").Fourmulaと変えたりしたのですが解決方法が解らなく どうか御教授下さい。 Dim コードナンバー As String Dim 品名1行 As String Dim QRdata As String QRdata = "=("& Chr(34) & コードナンバー & 品名1行 & Chr(34) & ",1)" Cells(3, 6).Value = QRdata  ←ここでエラーとなってしまいます。

  • エクセルVBAについて質問です。

    現在、マクロで重複データを削除する処理しています。 一応動作はするのですが、すごく遅いです。 およそ私のPC(XPのQuadコア)で1行処理するのに約0.85秒かかっています。 データが1万行以上もあるようなときは、何時間もかかってしまいます。 エクセルのデータは、以下のように、 A列とB列に文字列が何行にも渡って入っているものです。 A列   B列 AAA BBB CCC DDD EEE FFF GGG BBB CCC HHH CCC DDD (以下同様) 上のようなシートで、A列とB列の両方について重複する行を削除したいと思っています。 上記例だと、一番最後の「CCC-DDD」の箇所を削除したいです。 そこで以下のようなマクロを組みました。 (1)はじめに重複をチェックする変数(A列・B列)を取得します。 (2)上から順にチェックを開始します。 (3)A列・B列双方が取得した変数と一緒なら重複カウンターに1を加える。 (1回目の出現では削除しない) (4)チェックを続け、重複カウンターが2以上になった行は削除する。 (5)上記を空白行まで繰り返す。 というような流れです。 (マクロ記述の途中部分からです) '重複する行を削除 counter3 = 1 Do search_word1 = Cells(counter3, 1).Value search_word2 = Cells(counter3, 2).Value counter4 = 1 double_counter = 0 Do If Cells(counter4, 1).Value = search_word1 And Cells(counter4, 2).Value = search_word2 Then double_counter = double_counter + 1 If double_counter > 1 Then '二度以上出現した場合から削除する Cells(counter4, 1).EntireRow.Delete counter4 = counter4 - 1 End If End If counter4 = counter4 + 1 Loop Until Cells(counter4, 1).Value = "" counter3 = counter3 + 1 Loop Until Cells(counter3, 1) = "" 初心者なのもので、冗長や不適切な箇所などあるかと思います。 より効率的、あるいは、より早くできる書き方がありましたら、 ぜひともお教え下さい・よろしくお願いします。

  • VBAで特定の値がある行を連続コピーしたい

    Excel 2003 OS XP Professional SP3 VBAは自分でコードは組むことはできませんので見よう見まねでやっているレベルです。 A B C D E の列があり、行の1行目はタイトル行になっています。  A  B  C   D  E ***  ***  ***  ***  *** ’  AAA  BBB  CCC  DDD 111 222 333 '   EEE  FFF  GGG  HHH '   III  JJJ  KKK  LLL 444 555 '   MMM  NNN  OOO  PPP A列にカンマがある行にはB~E列に値が入力されていて、A列にカンマ以外の値が入力されている 場合にはB~Eには何も入力されていません。 A列にカンマ以外の値の時、カンマのある行のデータを次のカンマのある行までフィルハンドルをドラッグしてコピーするよう にしたいです。  A  B  C   D  E ***  ***  ***  ***  *** ’  AAA  BBB  CCC  DDD 111  AAA  BBB  CCC  DDD 222  AAA  BBB  CCC  DDD 333  AAA  BBB  CCC  DDD '   EEE  FFF  GGG  HHH '   III  JJJ  KKK  LLL 444  III  JJJ  KKK  LLL 555  III  JJJ  KKK  LLL '   MMM  NNN  OOO  PPP   sub 連続コピー() Dim r As Long Dim n As Long r = 2 n = r + 1 Do While Worksheets("sheet1").Cells(r, 1) <> "" If Worksheets("sheet1").Cells(r, 1).Value = Worksheets("sheet1").Cells(n, 1).Value Then r = n n = n + 1 Else Range(Cells(r, 2), Cells(r, 5)).Copy Range(Cells(n, 2), Cells(n, 5)) n = n + 1 End If Loop End Sub 自分なりに考えてみましたが、ぜんぜん動きません。 どなたかご教授をお願いします。

  • Excel VBAの繰返し処理を教えて下さい

    マクロを始めたばかりの初心者です。 どなたかご教示下さい。 リストから担当者社員番号をキーとして既定のシートにデータ転記し、別ファイルコピー後名前を付けて保存するというマクロを作成しています。 ご教示頂きたいのは、担当者別にファイルを作成したいのですが、 1行ごとの処理になり、無限ループでVBAが終了しません。 色々調べてみたものの、解決策が見つかりません。 どなたかご教示いただけないでしょうか。 読みにくいコードですが何卒よろしくお願い致します。 サンプルコード Sub 担当者用_個人用() Dim 行 As Integer Dim 年月 As String Dim メール行 As Integer Dim 担当者用 As String Dim 社員番号 As String Dim 社員名 As String Dim 残業対象 As String Dim 所属コード As String Dim 所属名 As String Dim 事業所コード As String Dim 事業所名 As String Dim 社員区分 As String Dim 平日時間外_m As String Dim 休日時間外_m As String Dim 時間外合計 As String Dim 前月時間外合計 As String Dim 前々月時間外合計 As String Dim 平均 As String Dim 問診票 As String Dim 削減書 As String Dim 担当者社員番号 As String Dim 担当者 As String Application.ScreenUpdating = False Sheets("個人用").Select 年月 = InputBox("OTレポートの「年月」を入力してください    例:(前月)2012年9月 → 201209") Range("A2") = 年月 Sheets("健康診断問診票").Select 行 = 5 メール行 = 5  【こちらの繰返し処理が無限ループになっています。ご教示頂けないでしょうか】       Do Until Cells(行, 17).Value = "" If Cells(行, 17).Value <> 担当者社員番号 Then End If 出力処理: 社員番号 = Cells(行, 1).Value 社員名 = Cells(行, 2).Value 残業対象 = Cells(行, 3).Value 所属名コード = Cells(行, 4).Value 所属名 = Cells(行, 5).Value 事業所コード = Cells(行, 6).Value 事業所名 = Cells(行, 7).Value 社員区分 = Cells(行, 8).Value 平日時間外_m = Cells(行, 9).Value 休日時間外_m = Cells(行, 10).Value 時間外合計 = Cells(行, 11).Value 前月時間外合計 = Cells(行, 12).Value 前々月時間外合計 = Cells(行, 13).Value 平均 = Cells(行, 14).Value 問診票 = Cells(行, 15).Value 削減書 = Cells(行, 16).Value 担当者社員番号 = Cells(行, 17).Value 担当者 = Cells(行, 18).Value Sheets("個人用").Select Range("A5").Select Cells(メール行, 1).Value = 社員番号 Cells(メール行, 2).Value = 社員名 Cells(メール行, 3).Value = 残業対象 Cells(メール行, 4).Value = 所属名コード Cells(メール行, 5).Value = 所属名 Cells(メール行, 6).Value = 事業所コード Cells(メール行, 7).Value = 事業所名 Cells(メール行, 8).Value = 社員区分 Cells(メール行, 9).Value = 平日時間外_m Cells(メール行, 10).Value = 休日時間外_m Cells(メール行, 11).Value = 時間外合計 Cells(メール行, 12).Value = 前月時間外合計 Cells(メール行, 13).Value = 前々月時間外合計 Cells(メール行, 14).Value = 平均 Cells(メール行, 15).Value = 問診票 Cells(メール行, 16).Value = 削減書 Cells(メール行, 17).Value = 担当者社員番号 Cells(メール行, 18).Value = 担当者 '個別ファイル作成 Sheets("個人用").Select Sheets("個人用").Copy 年月 = Cells(2, "A") 担当者社員番号 = Cells(5, "Q") 担当者 = Cells(5, "R") Application.DisplayAlerts = False 'メッセージを出さない ActiveWorkbook.SaveAs Filename:="C:\担当者用\" & ("勤怠抽出" & 年月 & "(" & 担当者社員番号 & " " & 担当者 & "さん" & ")") & ".xls" ActiveWorkbook.Save ActiveWindow.Close Sheets("個人用").Select Rows("5:5").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Sheets("健康診断問診票").Select 行の終わり: 行 = 行 + 1 Loop Sheets("ファイル作成").Select Range("A30").Select ActiveWorkbook.Save Application.ScreenUpdating = True MsgBox "ファイル作成が終了しました" End Sub

専門家に質問してみよう