人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルにて作業スケジュールの管理を行いたいです。
エクセル表計算(無理ならVBAで)で作成しようと考えています。

良い方法が見つからなくて困っています。
どなたか良い案があればお願いします。

1つのエクセルファイルに オーダー表と、作業スケジュールの2シートがあります

■オーダー表
NO 管理番号 作業1 作業2 作業3 ....... 作業10
1 A001 1/1 1/2 1/2
2 A002 2/1 - 2/1

■今回作成するスケジュール表
作業日 管理番号 作業の種類
1/1 A001 作業1
1/1 A001 作業2
1/2 A001 作業3
2/1 B001 作業1
2/1 B001 作業2

できれば並び替えせずに行いたいことと、作業のない部分は表示したくないないです。
例えば100*100マスを検索するとして、ブランクがあればどう処理するかについて悩んでいることと、
値が存在しなければ次へ進むような処理はエクセルの関数では難しいでしょうか?

よろしくお願いします。


【いるか賞の方へ500P差し上げます】

●質問者: pochi1234
●カテゴリ:ビジネス・経営 コンピュータ
✍キーワード:VBA いるか賞 かに たか つの
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● うぃんど
●100ポイント

関数だけで実行することも出来なくはなさそうですが複雑になりそうなのでクエリを提案

(VBAも便利なのですがクエリに慣れると色々便利なので・・・)

【1】クエリの使い方の確認と練習

xlsファイルは練習用にコピーしてから実施してください

手順は下記になります

http://www.eurus.dti.ne.jp/~yoneyama/Excel/filter2.htm

練習では丸ごとコピーになってます

【2】SQL

丸ごとコピーで使い方が判ってきたら、

(1)手順1から手順6までを行った続きの手順7で「MicrosoftQueryデータの表示またはクエリの編集を行う」を選択して下記のようなSQLに書き換えます

(2)MicrosoftQueryのウィンドウでは「SQL」というボタンをクリックして、次のように入力してOKします

(3)「SQLクエリを再表示できません。継続しますか?」と出てきたら気にせずOKをクリック

SELECT 作業1,管理番号,'作業1' FROM `Z:\Book1`.`Sheet1$` WHERE 作業1 > 0
UNION ALL
SELECT 作業2,管理番号,'作業2' FROM `Z:\Book1`.`Sheet1$` WHERE 作業2 > 0
UNION ALL
SELECT 作業3,管理番号,'作業3' FROM `Z:\Book1`.`Sheet1$` WHERE 作業3 > 0
UNION ALL
SELECT 作業4,管理番号,'作業4' FROM `Z:\Book1`.`Sheet1$` WHERE 作業4 > 0
UNION ALL
SELECT 作業5,管理番号,'作業5' FROM `Z:\Book1`.`Sheet1$` WHERE 作業5 > 0
UNION ALL
SELECT 作業6,管理番号,'作業6' FROM `Z:\Book1`.`Sheet1$` WHERE 作業6 > 0
UNION ALL
SELECT 作業7,管理番号,'作業7' FROM `Z:\Book1`.`Sheet1$` WHERE 作業7 > 0
UNION ALL
SELECT 作業8,管理番号,'作業8' FROM `Z:\Book1`.`Sheet1$` WHERE 作業8 > 0
UNION ALL
SELECT 作業9,管理番号,'作業9' FROM `Z:\Book1`.`Sheet1$` WHERE 作業9 > 0
UNION ALL
SELECT 作業10,管理番号,'作業10' FROM `Z:\Book1`.`Sheet1$` WHERE 作業10 > 0
ORDER BY 作業1

私の場合はZ:\Book1.xlsファイルのSheets1が元のデータなので上記のようになってます。実際のファイル名やシート名にあわせてください

(4)「ファイル」メニューから「MicrosaoftExcelにデータを返す」をクリックするとシートに反映されます

【3】注意点

オリジナルのデータを変更してもクエリの結果には反映されません

(右クリック「データを更新」などとすれば更新されます)

結果反映はVBAで自動的に処理させることもできます(下記一例)がデータ量によっては応答性が落ちる場合があります

クエリの結果を表示しているシートタブを右クリックしてコードを表示し

当該シートに下記のように記述すればシートを開く度に自動的にデータの更新を行ってくれます

Private Sub Worksheet_Activate()
 Range("A1").Select
 Selection.QueryTable.Refresh BackgroundQuery:=False
End Sub

補足必要でしたらコメント欄にて…

◎質問者からの返答

とても親切な回答ありがとうございます。しかし、客先に提出することもあるため、クエリがインストールされていないPCもあるため、使用するのが難しいです。

2次元配列を2つ使用して、ほしいデータへの変換はできたのですが、

別シートからの値の取得と、そのシートのへの貼り付け?がうまくできなくて困っていました。

Sub test()

Dim i As Long

Dim j As Long

Dim Data1(65536, 16) As String * 20

Dim Data2(65536, 4) As String * 20

Data1() = Worksheets("オーダー表").range("B14:Q50000")

For i = 0 To 65536

Data2(j, 0) = Data(i, 0)

Data2(j, l) = Data(i, 2)

Data2(j, 2) = Data(i, 5)

If Data1(i, 5) <> "" Then

Data2(j, 3) = "作業1"

j = j + 1

End If

Data2(j, 0) = Data(i, 0)

Data2(j, l) = Data(i, 2)

Data2(j, 2) = Data(i, 6)

If Data1(i, 6) <> "" Then

Data2(j, 3) = "作業2"

j = j + 1

End If

Next

ActiveSheet.Paste Destination:=Worksheets("スケジュール表") = Data2()

End Sub


2 ● Banias
●0ポイント

ピボットテーブルを使って集計してみてください。

◎質問者からの返答

ピボットテーブルではできなそうなのですが


3 ● Mook
●0ポイント

参考例は

1/1 A001 作業1

1/1 A001 作業2

1/2 A001 作業3

2/1 A002 作業1

2/1 A002 作業3

という解釈でよいでしょうか。


一応上記だと仮定してのマクロの例です。

Option Explicit

'// オーダー表シートの位置情報
Const ORDER_TITLE_ROW = 1  '// タイトル行
Const ORDER_ID_COL = "B"  '// 管理番号列

'// スケジュール表シートの位置情報
Const SCHEDULE_DATE_COL = "A"  '// 日付列
Const SCHEDULE_ID_COL = "B"  '// 管理番号列
Const SCHEDULE_WORK_COL = "C"  '// 作業の種類列


Sub MakeSchedule()
  '// オーダー表シート
 Dim orderWS As Worksheet
 Set orderWS = Worksheets("オーダー表")
 
  '// スケジュール表シート
 Dim scheduleWS As Worksheet
 Set scheduleWS = Worksheets("スケジュール表")
 
 Dim lastRow As Long
 lastRow = orderWS.Cells(Rows.Count, ORDER_ID_COL).End(xlUp).Row
 
  '// スケジュール表シートの初期化処理
 scheduleWS.Cells.ClearContents
 scheduleWS.Cells(1, SCHEDULE_DATE_COL).Value = "作業日"
 scheduleWS.Cells(1, SCHEDULE_ID_COL).Value = "管理番号"
 scheduleWS.Cells(1, SCHEDULE_WORK_COL).Value = "作業の種類"
 
 Dim r As Long
 Dim c As Long
 Dim dstRow As Long
 dstRow = 2
 For r = ORDER_TITLE_ROW + 1 To lastRow
 For c = Cells(ORDER_TITLE_ROW, ORDER_ID_COL).Column + 1 To Columns.Count
 If orderWS.Cells(ORDER_TITLE_ROW, c).Value <> "" And orderWS.Cells(r, c).Value <> "" Then
 scheduleWS.Cells(dstRow, SCHEDULE_DATE_COL).Value = orderWS.Cells(r, c).Value
 scheduleWS.Cells(dstRow, SCHEDULE_ID_COL).Value = orderWS.Cells(r, ORDER_ID_COL).Value
 scheduleWS.Cells(dstRow, SCHEDULE_WORK_COL).Value = orderWS.Cells(ORDER_TITLE_ROW, c).Value
 dstRow = dstRow + 1
 End If
 Next
 Next
End Sub

不明な点や仕様の誤解はコメントで対応しますので、

下記の「この質問・回答へのコメント」を有効にお願いします。


4 ● うぃんど
●100ポイント ベストアンサー

配列を介さない方法を選択してみました

A13からQ13までに「NO 管理番号 作業1 作業2 作業3 ....... 作業10」という見出しがあって14行目からデータがあるという想定にしてありますので、違う場合は"B13:Q13"を適宜修正してください

画面更新停止のコメントを外すのは動作確認出来てからにしてください

Option Explicit

Sub test2()
  '画面更新停止
  'Application.ScreenUpdating = False
 
  '準備
 Dim sheetA As Worksheet
 Dim sheetB As Worksheet
 Dim titleRange As String
 Dim startRow As Long
 Dim lastRow As Long
 Dim dataRows As Long
 Dim headLine As Range
 Dim headLineCount As Long
 Dim pasteRow As Long
 Dim lastCell As Range
 Dim i As Long
 
  '指定
 Set sheetA = Worksheets("オーダー表"): '読み込むシート
 Set sheetB = Worksheets("スケジュール表"): '書き出すシート
 titleRange = "B13:Q13": '見出し行(左端の行が管理番号となるように指定すること)
 
  '出力先シートの全面クリアと見出し行作成
 sheetB.Select
 Cells.ClearContents
 Range("A1:C1") = Array("作業日", "管理番号", "作業の種類")

  'コピー
 With sheetA
 Set headLine = .Range(titleRange)
 startRow = headLine(1).Row + 1: 'データ開始行
 lastRow = .Cells(.Rows.Count, headLine(1).Column).End(xlUp).Row: '最終行
 dataRows = lastRow - startRow + 1: 'データ件数
 headLineCount = headLine.Count: '見出し数
 pasteRow = 2: ' 書き出し位置
 For i = 2 To headLineCount
 .Range(.Cells(startRow, headLine(i).Column), .Cells(lastRow, headLine(i).Column)).Copy
 Cells(pasteRow, "A").Select
 ActiveSheet.Paste
 .Range(.Cells(startRow, headLine(1).Column), .Cells(lastRow, headLine(1).Column)).Copy
 Cells(pasteRow, "B").Select
 ActiveSheet.Paste
 Range(Cells(pasteRow, "C"), Cells(pasteRow + dataRows - 1, "C")).Value = headLine(i).Value
 pasteRow = pasteRow + dataRows
 Next i
 Application.CutCopyMode = False
 End With
 
  'ソート (優先順位は1:作業日、2:管理番号、3:作業種別)
 Columns("A:C").Select
 Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
 , Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending, Header:= _
 xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
 SortMethod:=xlPinYin
 
  '不要部分削除
 Set lastCell = Columns("A:A").Find("-"): ' -を検索
 If lastCell Is Nothing Then ' - が見当たらなかった場合
 Range(Cells(Columns("A:A").SpecialCells(xlCellTypeBlanks).Row, 1), Range("A1").SpecialCells(xlLastCell)).Delete
 Else ' - が見つかった場合
 Range(Cells(lastCell.Row, 1), Range("A1").SpecialCells(xlLastCell)).Delete
 End If
 
  '画面更新開始
 Application.ScreenUpdating = True
End Sub
◎質問者からの返答

かなりいい感じです。配列を使わずオブジェクトでできるんですね。

いるか賞候補です。

あつかましいお願いですが、初歩的な質問に答えて頂ければ 500P + 1000P以上 差し上げます。


仕様は


・オーダー表

No 受注日 管理番号 納期 作業1 ... 10

B C D E F ... Q



・スケジュール表

No 管理番号 作業の種類 作業日

A B C D

作業の種類には 作業1?10 のいずれかが入り

作業日には 作業のセルにある日付


にできればと考えています。


合わせて 作業1 ? 作業10の フォント色とセルの色をコピーできて 行にたいして貼り付けられればと

考えています。

よろしくお願い致します。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ