Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

25 / 76789

←次へ　｜　前へ→


	【82435】Re:エクセルシートを増やすと VBA の速度が遅くなる

westwindow - 25/1/24(金) 17:59 -


	引用なし

	パスワード

▼マナさん：
>▼westwindow さん：
>
>>1分かかる処理があるとして
>
>
>どんな処理ですか。コードを提示できませんか。
勤務表自動作成の処理の夜勤入力の部分です。宜しくお願い致します。

Sub 夜勤総合入力3()　　'山登り法による入力

　　　Range("本館全て").Select
　　　y1 = Selection(1).Row　　　　　　　　 '選択範囲の左上の行位置
　　　y2 = Selection(Selection.Count).Row　　'選択範囲の右下の行の位置
　　　x1 = Selection(1).Column　　　　　　　　 '選択範囲の左上の列位置
　　　x2 = Selection(Selection.Count).Column　　 '選択範囲の右下の列の位置
　　　x4 = Range("勤務表左上").Column - 1 + Day(Range("月末日")) '月末列番号

　　　For x = x1 To x2
　　　　　　Call 山登り法夜勤(x)
　　　Next x

End Sub

Sub 山登り法夜勤(x11)　'列指定

　　Dim 評価値1 As Single
　　Dim 評価値2 As Single

　　Dim a
　　Dim b

　　 Randomize

　　　　　　Randomize
　　　 Range("ガレージ範囲").Select
　　　yg1 = Selection(1).Row　　　　　　　　 '選択範囲の左上の行位置
　　　yg2 = Selection(Selection.Count).Row　　'選択範囲の右下の行の位置

　　　　Range("職員と夜勤ガレージ").Select
　　　y11 = Selection(1).Row　　　　　　　　 '選択範囲の左上の行位置
　　　y22 = Selection(Selection.Count).Row　　'選択範囲の右下の行の位置

　　　y60 = Range("ビット変数夜勤").Row　　　'チェックランの位置
　　　x60 = Range("ビット変数夜勤").Column

　　　y70 = Range("夜上限回数").Row　　　'チェックランの位置
　　　x70 = Range("夜上限回数").Column

　　　y80 = Range("夜総数").Row　　　'チェックランの位置
　　　x80 = Range("夜総数").Column

　　For i = 1 To 2000　　　　　　　　　　　　　　 '★★理想数は不明

'skip1:

　　　　判定 = 0 '初期化する

　　　　　 '初期セルを決める
　　　　 x1 = x11
　　　　 y1 = WorksheetFunction.RandBetween(y11, y22)

　　　　 x2 = x11
　　　　 y2 = WorksheetFunction.RandBetween(y11, y22)

　　　　 a = Cells(y1, x11)
　　　　 b = Cells(y2, x11)

　　　　 a_1 = Cells(y1, x11 + 1)
　　　　 a_2 = Cells(y1, x11 + 2)

　　　　 b_1 = Cells(y2, x11 + 1)
　　　　 b_2 = Cells(y2, x11 + 2)

　　　　　　　　'-------ビット変数を用意する------

　　　　　　　　 If a = "夜ほ" Then
　　　　　　　　　　a_bit = "100"
　　　　　　　　 End If
　　　　　　　　 If a = "夜鳥" Then
　　　　　　　　　　a_bit = "010"
　　　　　　　　 End If
　　　　　　　　 If a = "夜花虹" Then
　　　　　　　　　　a_bit = "001"
　　　　　　　　 End If
　　　　　　　　 If a = "" Then
　　　　　　　　　　a_bit = "000"
　　　　　　　　 End If

　　　　　　　　 If b = "夜ほ" Then
　　　　　　　　　　b_bit = "100"
　　　　　　　　 End If
　　　　　　　　 If b = "夜鳥" Then
　　　　　　　　　　b_bit = "010"
　　　　　　　　 End If
　　　　　　　　 If b = "夜花虹" Then
　　　　　　　　　　b_bit = "001"
　　　　　　　　 End If
　　　　　　　　 If b = "" Then
　　　　　　　　　　b_bit = "000"
　　　　　　　　 End If

　　　　　　　　' ----------------交換できるか調べる

　　　　　　　　　aa =
WorksheetFunction.Dec2Bin(WorksheetFunction.Bitand(WorksheetFunction.Bin2Dec
(Cells(y1, x60)), WorksheetFunction.Bin2Dec(b_bit)), 3)
　　　　　　　　　bb =
WorksheetFunction.Dec2Bin(WorksheetFunction.Bitand(WorksheetFunction.Bin2Dec
(Cells(y2, x60)), WorksheetFunction.Bin2Dec(a_bit)), 3)
　　　　　　　　　If a_bit = "000" Then　　　　　'交換元が空白の時は、どこで
も交換できる
　　　　　　　　　　bb = "111"
　　　　　　　　　End If
　　　　　　　　　If b_bit = "000" Then
　　　　　　　　　　aa = "111"
　　　　　　　　　End If
　　　　　　　　　If aa = "000" Or bb = "000" Then　　　　　'交換できないな
らば戻る
　　　　　　　　　　　　GoTo skip1
　　　　　　　　　End If

　　　　　　　　'--------評価値1 -------------

　　　　　　　　評価値1 = 夜勤総合評価(x11)

　　　　　　　　 If 評価値1 = 0 Then　　　　　　　　　　　　　　　　　 '評価
１が０なら終了
　　　　　　　　　　Exit Sub
　　　　　　　　 End If

　　　　　　　　'----------交換------------
　　　　　　　　 Cells(y1, x1) = b
　　　　　　　　 Cells(y2, x1) = a

　　　　　　　　'--------評価値2 -------------

　　　　　　　　評価値2 = 夜勤総合評価(x11)

　　　　　　　　'------------------------------------
　　　　　　　　　If Cells(y1, x80) > Cells(y1, x70) Or Cells(y2, x80) >
Cells(y2, x70) Then　 '上限数をこえていたら元に戻す

　　　　　　　　　　Cells(y1, x1) = a
　　　　　　　　　　Cells(y2, x1) = b
　　　　　　　　 End If

　　　　　　　　 If 評価値2 = 0 Then　 '評価が０なら終了

　　　　　　　　　　 Exit Sub
　　　　　　　　 End If

　　　　　　　　 If 評価値2 < 評価値1 Then　'評価が悪いと元に戻す

　　　　　　　　　　Cells(y1, x1) = a
　　　　　　　　　　Cells(y2, x1) = b
　　　　　　　　 End If

skip1:

　　Next i

End Sub

4 hits

▼

【82430】エクセルシートを増やすと VBA の速度が遅くなる westwindow 25/1/23(木) 15:16