質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.45%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

2回答

886閲覧

【VBA】ReDim文の中で条件分岐させる方法

koburon

総合スコア30

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2023/02/13 07:21

編集2023/02/13 07:22

前提

VBAで今日現在および任意の日の社員名簿を出力するマクロを作っています。以下の4シートを使用します。

  1. 異動DB
  2. 組織マスター
  3. 社員基本情報
  4. 現在の社員名簿

該当のソースコード

「異動DB」「組織マスター」「社員基本情報」を参照して、「現在の社員名簿」に書き込むコードです。

VBA

1Sub meibokosin(d As Date, c As Collection) 2 '複数枚のシートを合わせて社員名簿を作る 3 4 Dim kubun As Integer, today_d As Date, str_d As Date, end_d As Date 5 Dim no As Integer, syain_no As Long 6 Dim honbu As String, bu As String, ka As String, kakari As String 7 Dim sosikicode As Long, kakuzuke As String, kakuzuke_code As Long 8 Dim yakusyoku As String, yakusyoku_code As Integer, simei As String, seibetu As String, seinengappi As Long, nyusyabi As Long, _ 9 mailadd As String, gakureki As String, kenpo_no As String, nenkin_no As String, kisonenkin_no As String 10 Dim honbucode As Long, syozoku As String, syozoku_code As Long 11 12 Const AddCol As Long = 128 '追加列数 13 Dim aval(AddCol - 1) As Variant '追加列分格納領域 14 Dim i As Long '添え字 15 16 Dim wS1 As Worksheet 17 Dim wS2 As Worksheet 18 Dim wS3 As Worksheet 19 Dim wS4 As Worksheet 20 21 'ワークシートを変数で宣言する 22 Set wS1 = Worksheets("異動DB") 23 Set wS2 = Worksheets("組織マスター") 24 Set wS3 = Worksheets("社員基本情報") 25 Set wS4 = Worksheets("現在の社員名簿") 26 27 'ワークシートに出力している間の画面更新を停止 28 Application.ScreenUpdating = False 29 wS4.Activate 30 31 '前の結果をクリアする 32 n = wS4.Cells(Rows.Count, 1).End(xlUp).Row 33 If n > 2 Then 34 wS4.Range(Cells(3, 1), Cells(n, 151)).ClearContents 35 wS4.Range(Cells(3, 1), Cells(n, 151)).Borders.LineStyle = xlLineStyleNone 36 End If 37 38 '各シートの値を変数にセットする 39 For m = 1 To c.Count 40 R = c(m) 41 42 '「異動DB」 43 With wS1 44 today_d = d 45 kubun = .Cells(R, 1) 46 str_d = .Cells(R, 2) 47 end_d = .Cells(R, 3) 48 no = R 49 syain_no = .Cells(R, 4) 50 simei = .Cells(R, 5) 51 honbu = .Cells(R, 6) 52 bu = .Cells(R, 7) 53 ka = .Cells(R, 8) 54 kakari = .Cells(R, 9) 55 kakuzuke = .Cells(R, 10) 56 yakusyoku = .Cells(R, 11) 57 syozoku = .Cells(R, 12) 58 End With 59 60 '「社員基本情報」 61 Set rcd = wS3.Range("a:a").Find(syain_no, lookat:=xlWhole) 62 If Not rcd Is Nothing Then 63 seibetu = rcd.Offset(0, 2) 64 seinengappi = rcd.Offset(0, 3) 65 nyusyabi = rcd.Offset(0, 4) 66 mailadd = rcd.Offset(0, 5) 67 gakureki = rcd.Offset(0, 6) 68 kenpo_no = rcd.Offset(0, 7) 69 nenkin_no = rcd.Offset(0, 8) 70 kisonenkin_no = rcd.Offset(0, 9) 71 72 For i = 0 To UBound(aval) 73 aval(i) = rcd.Offset(0, 10 + i) 74 Next 75 End If 76 77 '「組織マスター」 78 With wS2 79 Set rcd_honbu = .Range("a:a").Find(honbu, lookat:=xlWhole) 80 Set rcd_bu = .Range("c:c").Find(bu, lookat:=xlWhole) 81 Set rcd_ka = .Range("e:e").Find(ka, lookat:=xlWhole) 82 Set rcd_kakari = .Range("g:g").Find(kakari, lookat:=xlWhole) 83 84 Set rcd_kakuzuke = .Range("k:k").Find(kakuzuke, lookat:=xlWhole) 85 kakuzuke_code = rcd_kakuzuke.Offset(0, 1) 86 87 Set rcd_yakusyoku = .Range("m:m").Find(yakusyoku, lookat:=xlWhole) 88 yakusyoku_code = rcd_yakusyoku.Offset(0, 1) 89 90 Set rcd_syozoku = .Range("i:i").Find(syozoku, lookat:=xlWhole) 91 syozoku_code = rcd_syozoku.Offset(0, 1) 92 End With 93 94 '退職(区分:3)を除く任意の日の各社員データを書き込む 95 Dim arr() As Variant 96 If (kubun <> 3 And str_d <= today_d And today_d <= end_d) Or _ 97 (str_d <= today_d And end_d = 0) Or _ 98 (kubun <> 3 And str_d > today_d And end_d = 0) Then 99 ReDim Preserve arr(151, p) 100 arr(0, p) = no 101 arr(1, p) = syain_no 102 arr(2, p) = honbu 103 arr(3, p) = bu 104 arr(4, p) = ka 105 arr(5, p) = kakari 106 arr(6, p) = sosikicode 107 arr(7, p) = kakuzuke 108 arr(8, p) = kakuzuke_code 109 arr(9, p) = yakusyoku 110 arr(10, p) = yakusyoku_code 111 arr(11, p) = simei 112 arr(12, p) = seibetu 113 arr(13, p) = seinengappi 114 arr(14, p) = nyusyabi 115 arr(15, p) = mailadd 116 arr(16, p) = gakureki 117 arr(17, p) = kenpo_no 118 arr(18, p) = nenkin_no 119 arr(19, p) = kisonenkin_no 120 arr(20, p) = honbucode 121 arr(21, p) = syozoku 122 arr(22, p) = syozoku_code 123 For i = 0 To UBound(aval) 124 arr(23 + i, p) = aval(i) 125 Next 126 127 p = p + 1 128 End If 129 Next m 130 131 With wS4.Range("a3").Resize(p, 151) 132 .Value = Application.WorksheetFunction.Transpose(arr) 133 End With 134 135 Application.ScreenUpdating = True 136End Sub

実現したいこと

今後入社予定の社員データを出力するため「今日あるいは未来の日の社員名簿」を出力するコードを書きましたが、「今日現在の社員名簿」も同時に別シートで出力するコードを書き加えたいです。

試したこと

新たに出力するシートは以下の通りで、97行目以降のIf文のうち3番目の条件(「区分が3でない」かつ「開始日が今日より後」かつ「終了日」)を無くして、「今日現在の各社員データ」を書くようにします。

Dim wS5 As Worksheet Set wS5 = Worksheets("今日時点の社員名簿")
'今日現在の各社員データを書き込む Dim arr() As Variant If (kubun <> 3 And str_d <= today_d And today_d <= end_d) Or _ (str_d <= today_d And end_d = 0) Then ReDim Preserve arr(151, p) arr(0, p) = no arr(1, p) = syain_no arr(2, p) = honbu arr(3, p) = bu arr(4, p) = ka arr(5, p) = kakari arr(6, p) = sosikicode arr(7, p) = kakuzuke arr(8, p) = kakuzuke_code arr(9, p) = yakusyoku arr(10, p) = yakusyoku_code arr(11, p) = simei arr(12, p) = seibetu arr(13, p) = seinengappi arr(14, p) = nyusyabi arr(15, p) = mailadd arr(16, p) = gakureki arr(17, p) = kenpo_no arr(18, p) = nenkin_no arr(19, p) = kisonenkin_no arr(20, p) = honbucode arr(21, p) = syozoku arr(22, p) = syozoku_code For i = 0 To UBound(aval) arr(23 + i, p) = aval(i) Next p = p + 1 End If Next m With wS5.Range("a3").Resize(p, 151) .Value = Application.WorksheetFunction.Transpose(arr) End With

もちろん別のSubで同じように書くことで別シートに書き込むことはできますが、出来れば1つのプロシージャ内で条件分岐で出力できるようにしたいので、アドバイスいただければと思います。よろしくお願いいたします。

補足情報(FW/ツールのバージョンなど)

PC:Windows11
ソフト:Microsoft365 Excel
参考URL:社員名簿を作る~その2~

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

ベストアンサー

meibokosinの1回の呼び出して、現在の社員名簿と今日時点の社員名簿を出力せずに、
meibokosinの1回の呼び出して、指定したどちらかのシートを出力するようにします。
meibokosinの呼び出し側は
call meibokosin(△,〇)のようにしているかと思いますが、以下のように変えます。
call meibokosin(△,〇,1)・・・・・現在の社員名簿の出力
call meibokosin(△,〇,2)・・・・・今日時点の社員名簿の出力
meibokosinを以下のように変えます。

VBA

1'out_type 1:現在の社員名簿 2:今日時点の社員名簿 2Sub meibokosin(d As Date, c As Collection, ByVal out_type As Long) 3'複数枚のシートを合わせて社員名簿を作る 4 5 Dim kubun As Integer, today_d As Date, str_d As Date, end_d As Date 6 Dim no As Integer, syain_no As Long 7 Dim honbu As String, bu As String, ka As String, kakari As String 8 Dim sosikicode As Long, kakuzuke As String, kakuzuke_code As Long 9 Dim yakusyoku As String, yakusyoku_code As Integer, simei As String, seibetu As String, seinengappi As Long, nyusyabi As Long, _ 10 mailadd As String, gakureki As String, kenpo_no As String, nenkin_no As String, kisonenkin_no As String 11 Dim honbucode As Long, syozoku As String, syozoku_code As Long 12 13 Const AddCol As Long = 128 '追加列数 14 Dim aval(AddCol - 1) As Variant '追加列分格納領域 15 Dim i As Long '添え字 16 17 Dim wS1 As Worksheet 18 Dim wS2 As Worksheet 19 Dim wS3 As Worksheet 20 Dim wS4 As Worksheet 21 22 'ワークシートを変数で宣言する 23 Set wS1 = Worksheets("異動DB") 24 Set wS2 = Worksheets("組織マスター") 25 Set wS3 = Worksheets("社員基本情報") 26 If out_type = 1 Then 27 Set wS4 = Worksheets("現在の社員名簿") 28 End If 29 If out_type = 2 Then 30 Set wS4 = Worksheets("今日時点の社員名簿") 31 End If 32 33 'ワークシートに出力している間の画面更新を停止 34 Application.ScreenUpdating = False 35 wS4.Activate 36 37 '前の結果をクリアする 38 n = wS4.Cells(Rows.Count, 1).End(xlUp).Row 39 If n > 2 Then 40 wS4.Range(Cells(3, 1), Cells(n, 151)).ClearContents 41 wS4.Range(Cells(3, 1), Cells(n, 151)).Borders.LineStyle = xlLineStyleNone 42 End If 43 44 '各シートの値を変数にセットする 45 For m = 1 To c.Count 46 r = c(m) 47 48 '「異動DB」 49 With wS1 50 today_d = d 51 kubun = .Cells(r, 1) 52 str_d = .Cells(r, 2) 53 end_d = .Cells(r, 3) 54 no = r 55 syain_no = .Cells(r, 4) 56 simei = .Cells(r, 5) 57 honbu = .Cells(r, 6) 58 bu = .Cells(r, 7) 59 ka = .Cells(r, 8) 60 kakari = .Cells(r, 9) 61 kakuzuke = .Cells(r, 10) 62 yakusyoku = .Cells(r, 11) 63 syozoku = .Cells(r, 12) 64 End With 65 66 '「社員基本情報」 67 Set rcd = wS3.Range("a:a").Find(syain_no, lookat:=xlWhole) 68 If Not rcd Is Nothing Then 69 seibetu = rcd.Offset(0, 2) 70 seinengappi = rcd.Offset(0, 3) 71 nyusyabi = rcd.Offset(0, 4) 72 mailadd = rcd.Offset(0, 5) 73 gakureki = rcd.Offset(0, 6) 74 kenpo_no = rcd.Offset(0, 7) 75 nenkin_no = rcd.Offset(0, 8) 76 kisonenkin_no = rcd.Offset(0, 9) 77 78 For i = 0 To UBound(aval) 79 aval(i) = rcd.Offset(0, 10 + i) 80 Next 81 End If 82 83 '「組織マスター」 84 With wS2 85 Set rcd_honbu = .Range("a:a").Find(honbu, lookat:=xlWhole) 86 Set rcd_bu = .Range("c:c").Find(bu, lookat:=xlWhole) 87 Set rcd_ka = .Range("e:e").Find(ka, lookat:=xlWhole) 88 Set rcd_kakari = .Range("g:g").Find(kakari, lookat:=xlWhole) 89 90 Set rcd_kakuzuke = .Range("k:k").Find(kakuzuke, lookat:=xlWhole) 91 kakuzuke_code = rcd_kakuzuke.Offset(0, 1) 92 93 Set rcd_yakusyoku = .Range("m:m").Find(yakusyoku, lookat:=xlWhole) 94 yakusyoku_code = rcd_yakusyoku.Offset(0, 1) 95 96 Set rcd_syozoku = .Range("i:i").Find(syozoku, lookat:=xlWhole) 97 syozoku_code = rcd_syozoku.Offset(0, 1) 98 End With 99 100 Dim arr() As Variant 101 Dim flag As Boolean 102 flag = False 103 If out_type = 1 Then 104 '退職(区分:3)を除く任意の日の各社員データを書き込む 105 If (kubun <> 3 And str_d <= today_d And today_d <= end_d) Or _ 106 (str_d <= today_d And end_d = 0) Or _ 107 (kubun <> 3 And str_d > today_d And end_d = 0) Then 108 flag = True 109 End If 110 End If 111 If out_type = 2 Then 112 '今日現在の各社員データを書き込む 113 If (kubun <> 3 And str_d <= today_d And today_d <= end_d) Or _ 114 (str_d <= today_d And end_d = 0) Then 115 flag = True 116 End If 117 End If 118 If flag = True Then 119 ReDim Preserve arr(151, p) 120 arr(0, p) = no 121 arr(1, p) = syain_no 122 arr(2, p) = honbu 123 arr(3, p) = bu 124 arr(4, p) = ka 125 arr(5, p) = kakari 126 arr(6, p) = sosikicode 127 arr(7, p) = kakuzuke 128 arr(8, p) = kakuzuke_code 129 arr(9, p) = yakusyoku 130 arr(10, p) = yakusyoku_code 131 arr(11, p) = simei 132 arr(12, p) = seibetu 133 arr(13, p) = seinengappi 134 arr(14, p) = nyusyabi 135 arr(15, p) = mailadd 136 arr(16, p) = gakureki 137 arr(17, p) = kenpo_no 138 arr(18, p) = nenkin_no 139 arr(19, p) = kisonenkin_no 140 arr(20, p) = honbucode 141 arr(21, p) = syozoku 142 arr(22, p) = syozoku_code 143 For i = 0 To UBound(aval) 144 arr(23 + i, p) = aval(i) 145 Next 146 147 p = p + 1 148 End If 149 Next m 150 151 With wS4.Range("a3").Resize(p, 151) 152 .Value = Application.WorksheetFunction.Transpose(arr) 153 End With 154 155 Application.ScreenUpdating = True 156End Sub

こちらで、動作環境が作れなかったので、動作確認はしていません。不明点があれば、補足してください。
変えた個所は、
If out_type = 1 Then
・・・
end if
If out_type = 2 Then
・・・
end if
です。
今後、第3のシートを出力する要件が発生した場合は、
If out_type = 3 Then
・・・
end if
のようにすれば、追加可能です。

投稿2023/02/15 06:22

tatsu99

総合スコア5476

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

koburon

2023/02/15 08:44

回答ありがとうございます。 meibokosinの中で処理させるコードで行ってみたのですが、ブックを開いて自動で動作させるようにしたところ、 35行目 wS4.Activate ここで「実行時エラー'91'」で中断してしまいました。 ws4が定義されていないという意味なのでしょうか?
tatsu99

2023/02/15 08:56

そのときのout_typeの値はどうなっていますか。 out_typeが1又は2であれば、wS4は値が設定されているのでエラーにならないはずです。 out_typeが上記以外なら、wS4は未設定なのでエラーになります。
tatsu99

2023/02/15 08:58

meibokosinを呼び出している個所はどうなっていますか? call meibokosin(△,〇,1)・・・・・現在の社員名簿の出力 のようになっていますか?
koburon

2023/02/16 02:37

meibokoshinを呼び出すコードですが、Call meibokosin(d, c, out_type) としていました。 下記のように分けて書き、更新の動作を確認しました。 Sub syokika() 'ブックを開くと自動で組織リスト・社員名簿を今日の日付で更新する Application.ScreenUpdating = False Dim d As Date d = Date Dim c As Collection Set c = New Collection For i = 2 To Worksheets("異動DB").Cells(Rows.Count, 1).End(xlUp).Row c.add i Next i '処理1(現在の社員名簿の更新) Call meibokosin(d, c, 1) '処理2(今日時点の社員名簿の更新) Call meibokosin(d, c, 2) Application.ScreenUpdating = True End Sub ただ、今度は40行目で「実行時エラー'1004'」('Range'メソッドは失敗しました。'_Worksheet'オブジェクト)で中断してしまいました。「wS4」の参照先が間違っているか指定されていないかだと思いますが、書き加える必要があるのでしょうか。
tatsu99

2023/02/16 02:54

39-42の下記の行ですが If n > 2 Then wS4.Range(Cells(3, 1), Cells(n, 151)).ClearContents wS4.Range(Cells(3, 1), Cells(n, 151)).Borders.LineStyle = xlLineStyleNone End If これを If n > 2 Then wS4.Range(wS4.Cells(3, 1), wS4.Cells(n, 151)).ClearContents wS4.Range(wS4.Cells(3, 1), wS4.Cells(n, 151)).Borders.LineStyle = xlLineStyleNone End If のように書き換えてください。 wS4.Range(Cells(3, 1), Cells(n, 151))の Cells(3, 1)は、ActiveSheetのCells(3, 1)になるのでwS4と異なる可能性があります。 今後は、必ず、シート名をつけて修飾するようにしてください。
koburon

2023/02/16 03:01

よく確認したところ、meibokosinの35行目:wS4.Activateの先頭部に「'」をつけてエスケープさせていました。 外して実行したところ、正しく2枚のシートに社員名簿が出力されました。 せっかく追記していただいたのに確認不足で申し訳ありません。 一応、時間があるのでいただいたコードを加えるとどうなるか確認してみます。
tatsu99

2023/02/16 03:27

>外して実行したところ、正しく2枚のシートに社員名簿が出力されました。 >一応、時間があるのでいただいたコードを加えるとどうなるか確認してみます。 了解しました。
koburon

2023/02/16 04:08

コードを追記して動作確認しましたが、問題なく書き込まれました。 今回はエラー回避できましたが、今後は参照シートを指定する癖を付けておく必要がありますね。
tatsu99

2023/02/16 04:22

>今回はエラー回避できましたが、今後は参照シートを指定する癖を付けておく必要がありますね。 この箇所はみんなが陥りやすい罠ですね。原因が特定しずらく私もはまりました。 一回、痛い目にあうと、次からは大丈夫だと思います。
koburon

2023/02/16 06:15

>一回、痛い目にあうと、次からは大丈夫だと思います。 了解しました。 最後まで細かい要望までコメントしてご対応いただきありがとうございました。
guest

0

前回の回答は、出力シート毎の処理をmeibokosinの中で行ってますが、これを外だしにしてすっきりさせたのが、以下の方法です。
set_wS4とOutConditionを作成し、それをmeibokosinから呼び出します。
set_wS4とOutConditionで参照する変数が多いので、以下の変数を共有変数にしています。
Dim kubun As Integer, today_d As Date, str_d As Date, end_d As Date
Dim wS4 As Worksheet

VBA

1'共有変数 2Dim kubun As Integer, today_d As Date, str_d As Date, end_d As Date 3Dim wS4 As Worksheet 4 5'out_type 1:現在の社員名簿 2:今日時点の社員名簿 6Sub meibokosin(d As Date, c As Collection, ByVal out_type As Long) 7'複数枚のシートを合わせて社員名簿を作る 8 9 Dim no As Integer, syain_no As Long 10 Dim honbu As String, bu As String, ka As String, kakari As String 11 Dim sosikicode As Long, kakuzuke As String, kakuzuke_code As Long 12 Dim yakusyoku As String, yakusyoku_code As Integer, simei As String, seibetu As String, seinengappi As Long, nyusyabi As Long, _ 13 mailadd As String, gakureki As String, kenpo_no As String, nenkin_no As String, kisonenkin_no As String 14 Dim honbucode As Long, syozoku As String, syozoku_code As Long 15 16 Const AddCol As Long = 128 '追加列数 17 Dim aval(AddCol - 1) As Variant '追加列分格納領域 18 Dim i As Long '添え字 19 20 Dim wS1 As Worksheet 21 Dim wS2 As Worksheet 22 Dim wS3 As Worksheet 23 24 'ワークシートを変数で宣言する 25 Set wS1 = Worksheets("異動DB") 26 Set wS2 = Worksheets("組織マスター") 27 Set wS3 = Worksheets("社員基本情報") 28 '出力シートを設定する 29 Call set_wS4(out_type) 30 31 'ワークシートに出力している間の画面更新を停止 32 Application.ScreenUpdating = False 33 wS4.Activate 34 35 '前の結果をクリアする 36 n = wS4.Cells(Rows.Count, 1).End(xlUp).Row 37 If n > 2 Then 38 wS4.Range(Cells(3, 1), Cells(n, 151)).ClearContents 39 wS4.Range(Cells(3, 1), Cells(n, 151)).Borders.LineStyle = xlLineStyleNone 40 End If 41 42 '各シートの値を変数にセットする 43 For m = 1 To c.Count 44 r = c(m) 45 46 '「異動DB」 47 With wS1 48 today_d = d 49 kubun = .Cells(r, 1) 50 str_d = .Cells(r, 2) 51 end_d = .Cells(r, 3) 52 no = r 53 syain_no = .Cells(r, 4) 54 simei = .Cells(r, 5) 55 honbu = .Cells(r, 6) 56 bu = .Cells(r, 7) 57 ka = .Cells(r, 8) 58 kakari = .Cells(r, 9) 59 kakuzuke = .Cells(r, 10) 60 yakusyoku = .Cells(r, 11) 61 syozoku = .Cells(r, 12) 62 End With 63 64 '「社員基本情報」 65 Set rcd = wS3.Range("a:a").Find(syain_no, lookat:=xlWhole) 66 If Not rcd Is Nothing Then 67 seibetu = rcd.Offset(0, 2) 68 seinengappi = rcd.Offset(0, 3) 69 nyusyabi = rcd.Offset(0, 4) 70 mailadd = rcd.Offset(0, 5) 71 gakureki = rcd.Offset(0, 6) 72 kenpo_no = rcd.Offset(0, 7) 73 nenkin_no = rcd.Offset(0, 8) 74 kisonenkin_no = rcd.Offset(0, 9) 75 76 For i = 0 To UBound(aval) 77 aval(i) = rcd.Offset(0, 10 + i) 78 Next 79 End If 80 81 '「組織マスター」 82 With wS2 83 Set rcd_honbu = .Range("a:a").Find(honbu, lookat:=xlWhole) 84 Set rcd_bu = .Range("c:c").Find(bu, lookat:=xlWhole) 85 Set rcd_ka = .Range("e:e").Find(ka, lookat:=xlWhole) 86 Set rcd_kakari = .Range("g:g").Find(kakari, lookat:=xlWhole) 87 88 Set rcd_kakuzuke = .Range("k:k").Find(kakuzuke, lookat:=xlWhole) 89 kakuzuke_code = rcd_kakuzuke.Offset(0, 1) 90 91 Set rcd_yakusyoku = .Range("m:m").Find(yakusyoku, lookat:=xlWhole) 92 yakusyoku_code = rcd_yakusyoku.Offset(0, 1) 93 94 Set rcd_syozoku = .Range("i:i").Find(syozoku, lookat:=xlWhole) 95 syozoku_code = rcd_syozoku.Offset(0, 1) 96 End With 97 98 Dim arr() As Variant 99 '出力シート対応に出力条件を判定する 100 If OutCondition(out_type) = True Then 101 ReDim Preserve arr(151, p) 102 arr(0, p) = no 103 arr(1, p) = syain_no 104 arr(2, p) = honbu 105 arr(3, p) = bu 106 arr(4, p) = ka 107 arr(5, p) = kakari 108 arr(6, p) = sosikicode 109 arr(7, p) = kakuzuke 110 arr(8, p) = kakuzuke_code 111 arr(9, p) = yakusyoku 112 arr(10, p) = yakusyoku_code 113 arr(11, p) = simei 114 arr(12, p) = seibetu 115 arr(13, p) = seinengappi 116 arr(14, p) = nyusyabi 117 arr(15, p) = mailadd 118 arr(16, p) = gakureki 119 arr(17, p) = kenpo_no 120 arr(18, p) = nenkin_no 121 arr(19, p) = kisonenkin_no 122 arr(20, p) = honbucode 123 arr(21, p) = syozoku 124 arr(22, p) = syozoku_code 125 For i = 0 To UBound(aval) 126 arr(23 + i, p) = aval(i) 127 Next 128 129 p = p + 1 130 End If 131 Next m 132 133 With wS4.Range("a3").Resize(p, 151) 134 .Value = Application.WorksheetFunction.Transpose(arr) 135 End With 136 137 Application.ScreenUpdating = True 138End Sub 139 140 141Private Sub set_wS4(ByVal out_type As Long) 142 If out_type = 1 Then 143 Set wS4 = Worksheets("現在の社員名簿") 144 End If 145 If out_type = 2 Then 146 Set wS4 = Worksheets("今日時点の社員名簿") 147 End If 148End Sub 149 150Private Function OutCondition(ByVal out_type As Long) 151 OutCondition = False 152 If out_type = 1 Then 153 '退職(区分:3)を除く任意の日の各社員データを書き込む 154 If (kubun <> 3 And str_d <= today_d And today_d <= end_d) Or _ 155 (str_d <= today_d And end_d = 0) Or _ 156 (kubun <> 3 And str_d > today_d And end_d = 0) Then 157 OutCondition = True 158 End If 159 End If 160 If out_type = 2 Then 161 '今日現在の各社員データを書き込む 162 If (kubun <> 3 And str_d <= today_d And today_d <= end_d) Or _ 163 (str_d <= today_d And end_d = 0) Then 164 OutCondition = True 165 End If 166 End If 167End Function 168

こちらも、動作確認していません。
どちらを採用するかは、あなたの方で判断してください。

投稿2023/02/15 06:31

tatsu99

総合スコア5476

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.45%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問