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

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

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

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

Q&A

解決済

2回答

732閲覧

VBA 文字を数値として計算

jabe

総合スコア43

VBA

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

0グッド

0クリップ

投稿2023/03/28 14:38

編集2023/03/29 02:38

実現したいこと

転記元表から転記先表へ以下条件をもとに計算し記入するVBAを作成したくご協力のほどよろしくお願いします。
<詳細>
転記先Noと合致する転記元表Noを以下条件のもと集約し計算して記入
例1.青木さん(V列)の場合、No1.A×12=2点×12=24点、記入結果(平均値)=24点/12行=2点、
よって転記先セル(E7)へAと記入※条件2より
例2.井川さん(W列)の場合、No2.A×1+B×1+C×1=2点+1点+0.5点=3.5点、記入結果(平均値)
=3.5点/3行=1.2(1.166..)点、よって転記先セル(F8)へBと記入
<条件>
1.ランクと点数の関係
A:2点
B:1点
C:0.5点
空白:0点
2.ランク算出式
2点以上はA
1点以上2点未満はB
0.5点以上1点未満はC
0点以上0.5点未満は空白
3.空白は0点としてカウント
4.作業者、Noとも場所は固定になります。
●対象excelの配置
イメージ説明
●転記先
イメージ説明
●転記元_1
イメージ説明
●転記元_2
イメージ説明
●転記元_3
イメージ説明

発生している問題・エラーメッセージ

思考錯誤しながら現コードにたどりついたのですが、以下壁にあたりました。
①該当Noを集約した計算が出来ませんでした。
②作業者、Noの組み合わせ数が多いため、私のやり方だと処理に時間がかかると考えた為、処理スピードもあげる方法も教えていただきたいです。

該当のソースコード

VBA

1Sub 作業者能力計算() 2Dim TF As Workbook 'VBA搭載ファイル宣言 3Set TF = ThisWorkbook 'VBA搭載ファイル格納 4 5Dim i As Long '転記元項番カウント 6Dim j As Long '転記先項番カウント 7Dim k As Long '転記元作業者カウント 8Dim l As Long '転記先作業者カウント 9Dim m As Long '平均値の分母 10Dim total As Double '転記元合計 11Dim hantei As Double '判定 12total = 0 13hantei = 0 14 15For k = 22 To 33 16 For l = 5 To 16 17 For i = 7 To 64 18 For j = 7 To 15 19 m = m + 1 20 If Cells(i, 2) = Cells(j, 19) Then '転記元と転記先の項番照合 21 If Cells(i, k) = "A" Then 22 hantei = 2 23 ElseIf Cells(i, k) = "B" Then 24 hantei = 1 25 ElseIf Cells(i, k) = "C" Then 26 hantei = 0.5 27 ElseIf Cells(i, k) = "" Then 28 hantei = 0 29 End If 30 total = hantei + total 31 total = total / m 32 If total >= 2 Then 33 Cells(j, l) = "A" 34 ElseIf total < 2 And total >= 1 Then 35 Cells(j, l) = "B" 36 ElseIf total < 1 And total >= 0.5 Then 37 Cells(j, l) = "C" 38 ElseIf total < 0.5 And total >= 0 Then 39 Cells(j, l) = "" 40 End If 41 End If 42 Next j 43 total = 0 44 hantei = 0 45 Next i 46 Next l 47Next k 48

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

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

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

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

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

logres_Fan

2023/03/28 15:09

Excelの事はよく知りませんが、A、B、Cじゃなくて、2、1、0.5を入力するようにしないの?表計算汎用ソフトなのにね。数値に応じて表示を変える方法を検討したほうが。
tatsu99

2023/03/29 02:14

転記先B列のNoと転記元S列のNo同士で、紐づけているように見えますが、 調整1,調整2,調整3は全てNo=8になっています。 これは、意図的なものでしょうか。もしそうであれば、NO同士で紐づけができないので、 転記先D列の内容と転記元T列の内容同士で、紐づけるようになります。 調整1,調整2,調整3はNo=8,9,10の間違いではないでしょうか。
jabe

2023/03/29 02:42

logres_Fanさん コメントありがとうございます。 確かにそうですね、ただ今回はA→数値→Aのように文字で対応したいと考えております。 tatsu99さん コメントありがとうございます。 仰る通り、誤りでした。 正しくは、転記先:No.8検査と転記元:No.8調整1、調整2、調整3になります。
logres_Fan

2023/03/29 03:29

> ただ今回はA→数値→Aのように文字で対応したいと考えております。 その場合も、数式とオートフィルで実現出来ないのでしょうか?
jabe

2023/03/29 09:06

返信ありがとうございます。 その場合、別シートをもうけないとできないですかね?
logres_Fan

2023/03/29 09:22

同じシートに、例えば、転記元(文字)→中間表(数値)→小計表(数値)→平均表(数値)→転記先では駄目でしょうか。参照セルを指定して変換・合計・平均など式を入れてオートフィル。問題が無ければ、数式を纏めて表を減らす感じで。
jabe

2023/03/30 00:28

返信ありがとうございます。 試してみます。
guest

回答2

0

変数iのループと変数jのループはiのループが内側ではないでしょうか。
m= m +1の行は転記元と転記先の項番照合のif文の内側へ
・分母で割る処理以降はiループの外側へ

VBA

1 For j = 7 To 15 2 3 For i = 7 To 64 4 If Cells(i, 2) = Cells(j, 19) Then '転記元と転記先の項番照合 5 '合計値計算、mカウント 6 End If 7 Next i 8 9 '分母で割る処理、結果出力 10 Total = Total / m 11 If Total >= 2 Then 12 Cells(j, l) = "A" 13 ElseIf Total < 2 And Total >= 1 Then 14 Cells(j, l) = "B" 15 ElseIf Total < 1 And Total >= 0.5 Then 16 Cells(j, l) = "C" 17 ElseIf Total < 0.5 And Total >= 0 Then 18 Cells(j, l) = "" 19 End If 20 21 '変数初期化 22 m = 0 23 Total = 0 24 hantei = 0 25 Next j 26

klは個別にループするのではなく1例としてはこんな感じで

VBA

1Dim k As Long '転記元Column 2Dim l As Long '転記先Column 3 4Dim 列オフセット As Long 5Dim 作業者人数 As Long 6 作業者人数 = 12 7 8For 列オフセット = 1 To 作業者人数 9 k = Cells(7, "V").Column + (列オフセット - 1) 10 l = Cells(7, "E").Column + (列オフセット - 1) 11 12Next

・処理速度に関しては配列を使っての一括書き込みを使わないのであればあまり変わらないかも。
以下の画面描画処理スキップで多少改善するかもしれません。

VBA

1Application.ScreenUpdating = False 2'処理 3Application.ScreenUpdating = True

投稿2023/03/28 17:03

編集2023/03/28 17:06
hawawa

総合スコア79

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

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

jabe

2023/03/29 09:00

連絡と参考コードありがとうございます。 参考にさせていただきます。
guest

0

ベストアンサー

以下のようにしてください。

VBA

1Option Explicit 2 3Dim ws As Worksheet '作業シート 4Public Sub 作業者能力計算() 5 Dim manNo As Long '作業者番号(左から1,2,3...) 6 Set ws = ActiveSheet 7 '転記先クリア 8 ws.Range("E7:P19").ClearContents 9 '全員分繰り返す 10 For manNo = 1 To 12 11 Call keisan(manNo) 12 Next 13 MsgBox ("完了") 14End Sub 15 16Private Sub keisan(ByVal manNo As Long) 17 Const MAXWORK As Long = 13 '最大作業数 18 Dim count(MAXWORK) As Long '件数 19 Dim point(MAXWORK) As Variant '得点 20 Dim wrow As Long '作業行番号 21 Dim trgcol As Long '転記先列 22 Dim srccol As Long '転記元列 23 Dim i As Long 24 Dim rank As String 'ランク 25 Dim wkno As Long '作業番号 26 Dim wp As Variant '得点 27 '集計テーブルクリア 28 For i = 1 To MAXWORK 29 count(i) = 0 30 point(i) = 0 31 Next 32 trgcol = 4 + manNo 33 srccol = 21 + manNo 34 '作業NOを全行分行う 35 For wrow = 7 To 64 36 '作業NO取得 37 wkno = ws.Cells(wrow, "S").Value 38 If wkno < 1 Or wkno > MAXWORK Then 39 MsgBox ("NO不正") 40 ws.Activate 41 ws.Cells(wrow, "S").Select 42 End 43 End If 44 'ランク取得 45 rank = ws.Cells(wrow, srccol).Value 46 wp = -1 47 If rank = "A" Then wp = 2 48 If rank = "B" Then wp = 1 49 If rank = "C" Then wp = 0.5 50 If rank = "" Then wp = 0 51 If wp = -1 Then 52 MsgBox ("ランク不正") 53 ws.Activate 54 ws.Cells(wrow, srccol).Select 55 End 56 End If 57 '集計テーブルへ加算 58 count(wkno) = count(wkno) + 1 59 point(wkno) = point(wkno) + wp 60 Next 61 '転記先へ出力 62 For wkno = 1 To MAXWORK 63 If count(wkno) <> 0 Then 64 wp = point(wkno) / count(wkno) 65 If wp >= 2 Then 66 rank = "A" 67 ElseIf wp >= 1 Then 68 rank = "B" 69 ElseIf wp >= 0.5 Then 70 rank = "C" 71 Else 72 rank = "" 73 End If 74 ws.Cells(wkno + 6, trgcol).Value = rank 75 End If 76 Next 77End Sub 78 79

投稿2023/03/29 05:29

tatsu99

総合スコア5470

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

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

jabe

2023/03/29 09:02

ご丁寧にコード教えていただきありがとうございます。 試したところ、私の要望通り正確かつスピーディに動作しました。 凄いです。 一行ずつ理解できるように読み解いていきます。また引続きよろしくお願いします。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.46%

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

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

質問する

関連した質問