[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『文字を別シートに反映させる』（若葉マーク）
教えて下さい！ シート：入力に日付ごとに内容を入力すると、担当した作業者のシートに反映されるようにしたいです。 担当者のシートは個人別にあります。日付ごとに5件入ります 宜しくお願いします。
＜シート：入力＞ A B C D E F G H I J K 1 日付 曜日 現場名 作業内容 時間 金額 元請 依頼先 作業者 2 8/1 月 お弁当屋 エアコン清9:00 ～ 11:30 福田 笠原 3 8/1 月 図書館 床掃除 10:00 ～ 12:00 佐藤 中村 4 8/1 月 レストラ 床掃除 15:00 ～ 18:00 笠原 中村 5 ～ 6 ～
＜シート：福田＞ A B C D E F G H I J K L M N 1 福田 2 日 付 曜日 現場名 時 間 実働 同行者 現場名 時 間 実働 同行者 3 8月1日 月 お弁当屋9:00 ～ 11:30 笠原 ～ 4 8月2日 火 ～ ～ 5 8月3日 水 ～ ～ 6 8月4日 木 ～ ～ 7 8月5日 金 ～ ～ 8 8月6日 土 ～
～ ＜シート：笠原＞ A B C D E F G H I J K L M N 1 笠原 2 日 付 曜日 現場名 時 間 実働 同行者 現場名 時 間 実働 同行者 3 8月1日 月 お弁当屋 9:00 ～ 11:30 福田レストラン 15:00 ～ 18:00 中村 4 8月2日 火 ～ ～ 5 8月3日 水 ～ ～ 6 8月4日 木 ～ ～ 7 8月5日 金 ～ ～ 8 8月6日 土 ～ ～
（若葉マーク）
レスがないようなので、これで。あまり綺麗じゃないVBAですが。
また、（若葉マーク）さんのやりたいことを誤解してたら申し訳ないんで、一度別名で保存してから、確認して下さい。
Dim 名前, 名前1, 名前2, 名前3, 名前4, 名前5, 日付 As Variant Dim 行1, 行2, Check, shn, i, n, a, b As Long
Option Explicit Sub 文字を別シートに反映させる()
Application.ScreenUpdating = False
Call 作業員分別 Call 並べ替え
Worksheets("入力").Select
行1 = Range("A65536").End(xlUp).Row
Range("A2:O" & 行1).Delete Shift:=xlUp
Range("A2").Select
Application.ScreenUpdating = True
End Sub
Private Sub 作業員分別()
With Worksheets("入力")
行1 = .Range("A65536").End(xlUp).Row
Check = 1
shn = Worksheets.Count
For a = 2 To 行1
名前1 = .Range("K" & a).Value
名前2 = .Range("L" & a).Value
名前3 = .Range("M" & a).Value
名前4 = .Range("N" & a).Value
名前5 = .Range("O" & a).Value
日付 = .Range("A" & a).Value
i = 0 名前 = 名前1 JOB:
i = i + 1
For n = 1 To shn
If Worksheets(n).Name = 名前 Then
Check = 0
Exit For
End If
Next n
If Check = 1 Then
Worksheets.Add After:=Worksheets(shn)
Worksheets(shn + 1).Name = 名前
Worksheets(名前).Range("A1").Value = 名前
Worksheets(名前).Range("A2").Value = "日付"
Worksheets(名前).Range("B2").Value = "曜日"
For b = 3 To 27 Step 6
Worksheets(名前).Cells(2, b).Value = "現場名"
Worksheets(名前).Cells(2, b + 1).Value = "時間"
Worksheets(名前).Cells(2, b + 4).Value = "実働"
Worksheets(名前).Cells(2, b + 5).Value = "同行者"
Next b
shn = shn + 1
End If
行2 = Worksheets(名前).Range("A65536").End(xlUp).Row + 1
.Range("A" & a & ":B" & a).Copy _
Destination:=Worksheets(名前).Range("A" & 行2 + 1)
.Range("C" & a).Copy _
Destination:=Worksheets(名前).Range("C" & 行2 + 1)
.Range("E" & a & ":G" & a).Copy _
Destination:=Worksheets(名前).Range("D" & 行2 + 1)
Worksheets(名前).Range("G" & 行2 + 1).FormulaR1C1 = "=RC[-1]-RC[-3]"
If .Range("K" & a) = 名前 Then
If .Range("L" & a) = "" Then
Worksheets(名前).Range("H" & 行2 + 1).Value = ""
ElseIf .Range("M" & a) = "" Then
Worksheets(名前).Range("H" & 行2 + 1).Value = _
.Range("L" & a)
ElseIf .Range("N" & a) = "" Then
Worksheets(名前).Range("H" & 行2 + 1).Value = _
.Range("L" & a) & "･" & .Range("M" & a)
ElseIf .Range("O" & a) = "" Then
Worksheets(名前).Range("H" & 行2 + 1).Value = _
.Range("L" & a) & "･" & .Range("M" & a) & "･" & .Range("N" & a)
Else
Worksheets(名前).Range("H" & 行2 + 1).Value = _
.Range("L" & a) & "･" & .Range("M" & a) & "･" & .Range("N" & a) & "･" & .Range("O" & a)
End If
ElseIf .Range("L" & a) = 名前 Then
If .Range("M" & a) = "" Then
Worksheets(名前).Range("H" & 行2 + 1).Value = _
.Range("K" & a)
ElseIf .Range("N" & a) = "" Then
Worksheets(名前).Range("H" & 行2 + 1).Value = _
.Range("K" & a) & "･" & .Range("M" & a)
ElseIf .Range("O" & a) = "" Then
Worksheets(名前).Range("H" & 行2 + 1).Value = _
.Range("K" & a) & "･" & .Range("M" & a) & "･" & .Range("N" & a)
Else
Worksheets(名前).Range("H" & 行2 + 1).Value = _
.Range("K" & a) & "･" & .Range("M" & a) & "･" & .Range("N" & a) & "･" & .Range("O" & a)
End If
ElseIf .Range("M" & a) = 名前 Then
If .Range("N" & a) = "" Then
Worksheets(名前).Range("H" & 行2 + 1).Value = _
.Range("K" & a) & "･" & .Range("L" & a)
ElseIf .Range("O" & a) = "" Then
Worksheets(名前).Range("H" & 行2 + 1).Value = _
.Range("K" & a) & "･" & .Range("L" & a) & "･" & .Range("N" & a)
Else
Worksheets(名前).Range("H" & 行2 + 1).Value = _
.Range("K" & a) & "･" & .Range("L" & a) & "･" & .Range("N" & a) & "･" & .Range("O" & a)
End If
ElseIf .Range("N" & a) = 名前 Then
If .Range("O" & a) = "" Then
Worksheets(名前).Range("H" & 行2 + 1).Value = _
.Range("K" & a) & "･" & .Range("L" & a) & "･" & .Range("M" & a)
Else
Worksheets(名前).Range("H" & 行2 + 1).Value = _
.Range("K" & a) & "･" & .Range("L" & a) & "･" & .Range("M" & a) & "･" & .Range("O" & a)
End If
Else
Worksheets(名前).Range("H" & 行2 + 1).Value = _
.Range("K" & a) & "･" & .Range("L" & a) & "･" & .Range("M" & a) & "･" & .Range("N" & a)
End If
If i = 1 Then
If 名前2 <> "" Then
名前 = 名前2
GoTo JOB
End If
ElseIf i = 2 Then
If 名前3 <> "" Then
名前 = 名前3
GoTo JOB
End If
ElseIf i = 3 Then
If 名前4 <> "" Then
名前 = 名前4
GoTo JOB
End If
ElseIf i = 4 Then
If 名前5 <> "" Then
名前 = 名前5
GoTo JOB
End If
End If
Next a End With
End Sub
Private Sub 並べ替え()
shn = Worksheets.Count
For a = 1 To shn
If Worksheets(a).Name <> "入力" Then
Worksheets(a).Select
行1 = ActiveSheet.Range("A1").End(xlDown).Row + 2
行2 = ActiveSheet.Range("A65536").End(xlUp).Row
If 行1 = 行2 Then
ActiveSheet.Rows(行1 - 1).Delete Shift:=xlUp
Else
ActiveSheet.Range("A" & 行1 & ":H" & 行2).Select
Selection.Sort Key1:=Range("D" & 行1), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
ActiveSheet.Range("C" & 行1 + 1 & ":H" & 行1 + 1).Copy _
Destination:=Worksheets(a).Range("I" & 行1)
ActiveSheet.Range("C" & 行1 + 2 & ":H" & 行1 + 2).Copy _
Destination:=Worksheets(a).Range("O" & 行1)
ActiveSheet.Range("C" & 行1 + 3 & ":H" & 行1 + 3).Copy _
Destination:=Worksheets(a).Range("U" & 行1)
ActiveSheet.Range("C" & 行1 + 4 & ":H" & 行1 + 4).Copy _
Destination:=Worksheets(a).Range("AA" & 行1)
ActiveSheet.Range("A" & 行1 + 1 & ":H" & 行1 + 4).Delete Shift:=xlUp
ActiveSheet.Rows(行1 - 1).Delete Shift:=xlUp
End If
ActiveSheet.Columns("A:AF").EntireColumn.AutoFit
ActiveSheet.Range("A1").Select
End If
Next a
End Sub
(ken)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.