Results of 1 - 1 of about 37700 for IF (0.008 sec.)
- [[20231110142656]]
- #score: 1591
- @digest: 37812fd70abbffb4088565456356215c
- @id: 95519
- @mdate: 2023-11-14T11:29:41Z
- @size: 15562
- @type: text/plain
- #keywords: errormsg (187051), targetcol (159493), targetrow (126443), foundcolumn (118093), 得ye (38744), 記ta (31932), 年" (22997), 定if (16396), 業実 (16380), 年= (16110), ベテ (15710), 示if (12545), ン_ (12172), テラ (11376), 新人 (10282), integer (8427), ws2 (8179), る年 (7197), ws1 (7129), 定se (6325), 合if (6073), month (5750), 行ボ (5695), year (5287), 件数 (4818), vbexclamation (4507), 年月 (4325), cells (3715), 月" (3573), 営業 (3070), デバ (3002), until (2940)
- 『指定した年月の営業実績件数を降順に出力できるようなランキング機能。 』（初心者その1）
https://f.yourl.jp/7434797e こちらの表を↓完成形のイメージ https://f.yourl.jp/9a3512f2/ このようにしたいのですが（これは手作業） （2）Do until文で 営業開始日から8ヶ月未満部門と8ヶ月以上部門で順位を別々に出力する。 （3）必要に応じて、機能変更を行わない範囲で、既存シートに行、列を追加、 または書式設定等を変更することは可とする。 （4）ソート処理において、SORT関数、RANK関数は使用しないこと。 ※「バブルソート」アルゴリズムを使って実現すること （5）件数に応じて、人数ベースで順位を表示すること。 例）同順位が複数人存在する場合 1位 Aさん 2位 Bさん 2位 Cさん 4位 Dさん (2)からのコードがうまいこといってくれません。こういう答えもあるとかアドバイスいただけたらお願いします。20時間以上詰まってます。 コードはこちら。 Sub 実行ボタン_Click() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim year As Integer Dim month As Integer Dim i As Integer Dim errorMsg As String Dim targetRow As Integer Dim targetCol As Integer Dim j As Integer Dim Row As Integer Dim Col As Integer ' シートを指定 Set ws1 = ThisWorkbook.Sheets("Sheet1") Set ws2 = ThisWorkbook.Sheets("営業実績（稼働件数推移）") ' 年と月をB2とD2から取得 year = ws1.Range("B2").Value month = ws1.Range("D2").Value ' 年と月が変更された場合、シート1のデータをクリア ws1.Range("B11:AD11").Clear ' 年の判定 If year & "年" <> "2019年" And year & "年" <> "2020年" Then errorMsg = "年は2019年か2020年を入力してください。" End If ' 月の判定 If month < 1 Or month > 12 Then errorMsg = "月は1から12の範囲で入力してください。" End If ' データを出力 i = 9 Row = 5 targetRow = 10 targetCol = 16 MsgBox ws2.Cells(3, i).Value MsgBox ws2.Cells(4, i).Value ' 対応する年の列が見つかるまでループ 別ものとして考える Do Until i > 29 If ws2.Cells(3, i).Value = year & "年" And ws2.Cells(4, i).Value = month & "月" Then ' 会社名を転記 ' j = 5 End If i = i + 1 ' 次の列に進む Loop ' targetRowとtargetColの値をデバッグ表示 MsgBox "targetRow: " & targetRow MsgBox "targetCol: " & targetCol ' 対応する年月が見つからなかった場合 If i > 29 Then errorMsg = "指定した年月のデータが見つかりません。" End If ' エラーメッセージが設定されている場合は表示 If Len(errorMsg) > 0 Then MsgBox errorMsg, vbExclamation End If End Sub 途中までのコードです。 まずは→側に指定した年月の、会社名、氏名、件数の数字がある人を転記したくて 次に8ヶ月未満※ある人ない人、の判定 最後に降順バブルソートで順位繰り上げ表示で完了です。 ＜ 使用 Excel:Excel2019、使用 OS:Windows10 ＞ ---- Sub 実行ボタン_Click() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim year As Integer Dim month As Integer Dim i As Integer Dim errorMsg As String Dim targetRow As Integer Dim targetCol As Integer Dim j As Integer Dim Row As Integer ' シートを指定 Set ws1 = ThisWorkbook.Sheets("Sheet1") Set ws2 = ThisWorkbook.Sheets("営業実績（稼働件数推移）") ' 年と月をB2とD2から取得 year = ws1.Range("B2").Value month = ws1.Range("D2").Value ' 年と月が変更された場合、シート1のデータをクリア ws1.Range("B11:AD11").Clear ' 年の判定 If year & "年" <> "2019年" And year & "年" <> "2020年" Then errorMsg = "年は2019年か2020年を入力してください。" End If ' 月の判定 If month < 1 Or month > 12 Then errorMsg = "月は1から12の範囲で入力してください。" End If ' データを出力 i = 9 Row = 5 targetRow = 10 targetCol = 16 ' 対応する年の列が見つかるまでループ Do Until i > 29 If ws2.Cells(3, i).Value = year & "年" And ws2.Cells(4, i).Value = month & "月" Then ' 会社名を転記 ' 漢字氏名 ' 件数 j = 5 Do Until j > 43 ws1.Cells(targetRow, targetCol).Value = ws2.Cells(j, 3).Value ws1.Cells(targetRow, targetCol + 1).Value = ws2.Cells(j, 3 + 1).Value ws1.Cells(targetRow, targetCol + 2).Value = ws2.Cells(j, i + 2).Value ' 次のセットに進む targetRow = targetRow + 1 j = j + 1 Loop Exit Do End If i = i + 1 ' 次の列に進む Loop ' targetRowとtargetColの値をデバッグ表示 MsgBox "targetRow: " & targetRow MsgBox "targetCol: " & targetCol ' 対応する年月が見つからなかった場合 If i > 29 Then errorMsg = "指定した年月のデータが見つかりません。" End If ' エラーメッセージが設定されている場合は表示 If Len(errorMsg) > 0 Then MsgBox errorMsg, vbExclamation End If End Sub 現在このコードで2019年4月の件数データは引っ張ることに成功しましたが。 ws1.Cells(targetRow, targetCol).Value = ws2.Cells(j, 3).Value ws1.Cells(targetRow, targetCol + 1).Value = ws2.Cells(j, 3 + 1).Value ws1.Cells(targetRow, targetCol + 2).Value = ws2.Cells(j, i + 2).Value ここの部分の複数の指定セルに別シートに転記をしたいです。 ws2.Cells(j, i)にして正常に動かせる文が思いつかない状態です。 （初心者その1） 2023/11/10(金) 16:41:18 ---- ＞現在このコードで2019年4月の件数データは引っ張ることに成功しましたが。 If ws2.Cells(3, i).Value = year & "年" And ws2.Cells(4, i).Value = month & "月" Then 結合セルは結合範囲の最初のセルに値を持っているので、 2019年5月の列に移動してしまうと、ws2.Cells(3, i).Value は空になるので、年月の取得が出来ていません。 2019年4月の場合は、結合セルの最初なので「2019年」を取得しているので成功したということです。 Dim 年 As String と宣言して、ループの最初に If ws2.Cells(3, i) <> "" Then 年 = ws2.Cells(3, i) としてから、 If 年 = year & "年" And ws2.Cells(4, i).Value = month & "月" Then としてみてください。 コードが思う様に動作していないと思ったら、デバッグすることをオススメします。 デバッグのひとつとして、ステップ実行があります。 コードを1行ずつ実行して確認する方法です。 今回のケースだとws2.Cells(3, i).Valueを確認しながら動かせば、空だったことがわかったと思います。 以下、参考です。この他にもありますので「VBA デバッグ 方法」等でWeb検索して自分にあった記事を探して下さい。 https://excel-ubara.com/excelvba1/EXCELVBA490.html 外部サイトへのリンクは敬遠されるケースが多いので、 [[20110209184943]][談]シートレイアウトの投稿どうしてますか?』（momo） にあるようなコードを用いて、テキストとして投稿されると返答が付きやすいと思います。 （外野フライ） 2023/11/11(土) 08:56:57 ---- 返信遅れました。 ありがとうございます! 試してみます。 （初心者その1） 2023/11/12(日) 13:33:36 ---- Sub 実行ボタン_Click() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim year As Integer Dim month As Integer Dim i As Integer Dim errorMsg As String Dim targetRow As Integer Dim targetCol As Integer Dim j As Integer Dim Row As Integer Dim foundColumn As Integer Dim 年 As String Dim 月 As String ' シートを指定 Set ws1 = ThisWorkbook.Sheets("Sheet1") Set ws2 = ThisWorkbook.Sheets("営業実績（稼働件数推移）") ' 年と月をB2とD2から取得 year = ws1.Range("B2").Value month = ws1.Range("D2").Value ' 年と月が変更された場合、シート1のデータをクリア ws1.Range("B11:AD11").Clear ' 年の判定 If year & "年" <> "2019年" And year & "年" <> "2020年" Then errorMsg = "年は2019年か2020年を入力してください。" End If ' 月の判定 If month < 1 Or month > 12 Then errorMsg = "月は1から12の範囲で入力してください。" End If ' 対応する年の列が見つかるまでループ foundColumn = 0 i = 9 Do Until i > 29 If 年 = year & "年" And ws2.Cells(4, i).Value = month & "月" Then foundColumn = i Exit Do End If i = i + 1 ' 次の列に進む Loop ' 対応する年月が見つからなかった場合 If foundColumn = 0 Then errorMsg = "指定した年月のデータが見つかりません。" Else ' 会社名、漢字氏名、件数の転記 targetRow = 10 targetCol = 16 j = 5 Do Until j > 43 ws1.Cells(targetRow, targetCol).Value = ws2.Cells(j, i).Value ws1.Cells(targetRow, targetCol + 1).Value = ws2.Cells(j, i + 1).Value ws1.Cells(targetRow, targetCol + 2).Value = ws2.Cells(j, foundColumn).Value ' 次のセットに進む targetRow = targetRow + 1 j = j + 1 Loop End If ' targetRowとtargetColの値をデバッグ表示 MsgBox "targetRow: " & targetRow MsgBox "targetCol: " & targetCol ' エラーメッセージが設定されている場合は表示 If Len(errorMsg) > 0 Then MsgBox errorMsg, vbExclamation End If End Sub すみません。アドバイスしてくれた箇所を修正したところ年月データは見つかりませんとでます。 アドバイスあればよろしくお願いします。 （初心者その1） 2023/11/13(月) 10:17:36 ---- Sub 実行ボタン_Click() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim year As Integer Dim month As Integer Dim i As Integer Dim errorMsg As String Dim targetRow As Integer Dim targetCol As Integer Dim j As Integer Dim Row As Integer Dim foundColumn As Integer Dim 年 As String Dim 月 As String ' シートを指定 Set ws1 = ThisWorkbook.Sheets("Sheet1") Set ws2 = ThisWorkbook.Sheets("営業実績（稼働件数推移）") ' 年と月をB2とD2から取得 year = ws1.Range("B2").Value month = ws1.Range("D2").Value ' 年と月が変更された場合、シート1のデータをクリア ws1.Range("B11:AD11").Clear ' 年の判定 If year & "年" <> "2019年" And year & "年" <> "2020年" Then errorMsg = "年は2019年か2020年を入力してください。" End If ' 月の判定 If month < 1 Or month > 12 Then errorMsg = "月は1から12の範囲で入力してください。" End If ' 対応する年の列が見つかるまでループ foundColumn = 0 i = 9 Do Until i > 29 If ws2.Cells(3, i) <> "" Then 年 = ws2.Cells(3, i) If 年 = year & "年" And ws2.Cells(4, i).Value = month & "月" Then foundColumn = i Exit Do End If i = i + 1 ' 次の列に進む Loop ' 対応する年月が見つからなかった場合 If foundColumn = 0 Then errorMsg = "指定した年月のデータが見つかりません。" Else ' 会社名、漢字氏名、件数の転記 targetRow = 10 targetCol = 14 j = 5 Do Until j > 43 ws1.Cells(targetRow, targetCol).Value = ws2.Cells(j, 3).Value ws1.Cells(targetRow, targetCol + 1).Value = ws2.Cells(j, 4).Value ws1.Cells(targetRow, targetCol + 2).Value = ws2.Cells(j, foundColumn).Value ' 次のセットに進む targetRow = targetRow + 1 j = j + 1 Loop End If ' targetRowとtargetColの値をデバッグ表示 MsgBox "targetRow: " & targetRow MsgBox "targetCol: " & targetCol ' エラーメッセージが設定されている場合は表示 If Len(errorMsg) > 0 Then MsgBox errorMsg, vbExclamation End If End Sub すみません。 ちゃんと修正しましたら正常に動きました。 ありがとうございます。 次は新人とベテランに分けるためにフラグ管理について頑張ります。 （初心者その1） 2023/11/13(月) 10:33:48 ---- Sub 実行ボタン_Click() ' 変数の宣言 Dim ws1 As Worksheet Dim ws2 As Worksheet Dim year As Integer Dim month As Integer Dim i As Integer Dim errorMsg As String Dim targetRow As Integer Dim targetCol As Integer Dim j As Integer Dim Row As Integer Dim foundColumn As Integer Dim 年 As String Dim 月 As String ' シートを指定 Set ws1 = ThisWorkbook.Sheets("Sheet1") Set ws2 = ThisWorkbook.Sheets("営業実績（稼働件数推移）") ' 年と月をB2とD2から取得 year = ws1.Range("B2").Value month = ws1.Range("D2").Value ' 年と月が変更された場合、シート1のデータをクリア ws1.Range("B11:AD11").Clear ' 年の判定 If year & "年" <> "2019年" And year & "年" <> "2020年" Then errorMsg = "年は2019年か2020年を入力してください。" End If ' 月の判定 If month < 1 Or month > 12 Then errorMsg = "月は1から12の範囲で入力してください。" End If ' 対応する年の列が見つかるまでループ foundColumn = 0 i = 9 Do Until i > 29 If ws2.Cells(3, i) <> "" Then 年 = ws2.Cells(3, i) If 年 = year & "年" And ws2.Cells(4, i).Value = month & "月" Then foundColumn = i Exit Do End If i = i + 1 ' 次の列に進む Loop ' 対応する年月が見つからなかった場合 If foundColumn = 0 Then errorMsg = "指定した年月のデータが見つかりません。" Else ' 会社名、漢字氏名、件数の転記 targetRow = 11 ' ※が含まれているかどうかの判定を行いながら、指定した年月の行を1つずつずらしていく j = 5 Do Until j > 43 If InStr(ws2.Cells(j, 8).Value, "※") > 0 Then ' ※が含まれている場合はws1.Cells(targetRow, 2)から転記 targetCol = 2 Else ' ※が含まれていない場合はws1.Cells(targetRow, 8)から転記 targetCol = 8 End If ' 会社名、漢字氏名、件数の転記 ws1.Cells(targetRow, targetCol).Value = ws2.Cells(j, 3).Value ws1.Cells(targetRow, targetCol + 1).Value = ws2.Cells(j, 4).Value ws1.Cells(targetRow, targetCol + 2).Value = ws2.Cells(j, foundColumn).Value ' 次のセットに進む targetRow = targetRow + 1 j = j + 1 Loop End If ' エラーメッセージが設定されている場合は表示 If Len(errorMsg) > 0 Then MsgBox errorMsg, vbExclamation End If End Sub 現在新人とベテランにわけて転記するという所まで来ましたが このコードですと飛び飛びに転記してしまい、行を詰めながら順番に転記するという処理はどう書けばいいでしょうか? （初心者その1） 2023/11/13(月) 14:42:45 ---- 全然きちんと見ていないので的外れならスミマセン。 ・転記先の行管理用の変数を別途作る ・新人は新人、ベテランはベテランで配列にぶち込んでから転記 とかでどうでしょ? （i） 2023/11/13(月) 17:49:03 ---- 既にご指摘ありますが、 If ※が含まれている場合 Then 新人行 = 新人行 + 1 ws1.Cells(新人行, 2)・・・・ Else ベテラン行 = ベテラン行 + 1 ws1.Cells(ベテラン行, 8)・・・ End If みたいにするか、 別の方法だと、まず、ws1.Range("B11:AD11").Clear この箇所を見直して、 見出し行より下は全てクリアするようにしてから、 都度最下行を求めて、その直下に書き込むようにするとか。 With ws1.Cells(Rows.Count, targetCol).End(xlUp).Offset(1) .Resize(, 2).Value = ws2.Cells(j, 3).Resize(, 2).Value .Offset(, 2).Value = ws2.Cells(j, foundColumn).Value End With （外野フライ） 2023/11/13(月) 20:08:44 ---- お二方、アドバイスありがとうございます! 助かりました! またわからなくなったら教えてください! （初心者その1） 2023/11/14(火) 20:29:41... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/202311/20231110142656.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97065 documents and 608341 words.
訪問者：