VBAのコードです
Sub 集計()
Dim i As Long, db, wk
Set db = CreateObject("Scripting.Dictionary")
With Sheets("Upデータ")
For i = 3 To .Cells(Rows.Count, "E").End(xlUp).Row
If .Cells(i, "D") <> "" Then
wk = .Cells(i, "E")
db(wk) = db(wk) + .Cells(i, "D")
End If
Next
.Cells(4, "H").Resize(db.Count) = Application.Transpose(db.keys)
.Cells(4, "I").Resize(db.Count) = Application.Transpose(db.items)
End With
Set db = Nothing
End Sub
Sub 集計結果()
Worksheets.Add After:=Sheets("Upデータ")
ActiveSheet.Name = "集計結果"
Worksheets("集計結果").Cells("L", 6).Value = Worksheets("Upデータ").Cells("H", 6).Value
End Sub
Sub aaaaaa()
Dim i As Long
Dim x As Long
x = Worksheets("Upデータ").Cells(Rows.Count, 8).End(xlUp).Row
For i = 2 To x
If Worksheets("Upデータ").Cells(i, 8) = "広瀬" Then
Worksheets("集計結果").Cells(32, 13).Value = Worksheets("Upデータ").Cells(i, 9).Value
End If
Next i
For i = 2 To x
If Worksheets("Upデータ").Cells(i, 8) = "上田" Then
Worksheets("集計結果").Cells(33, 13).Value = Worksheets("Upデータ").Cells(i, 9).Value
End If
Next i
For i = 2 To x
If Worksheets("Upデータ").Cells(i, 8) = "桜井" Then
Worksheets("集計結果").Cells(34, 13).Value = Worksheets("Upデータ").Cells(i, 9).Value
End If
Next i
For i = 2 To x
If Worksheets("Upデータ").Cells(i, 8) = "飯田" Then
Worksheets("集計結果").Cells(35, 13).Value = Worksheets("Upデータ").Cells(i, 9).Value
End If
Next i
For i = 2 To x
If Worksheets("Upデータ").Cells(i, 8) = "大村" Then
Worksheets("集計結果").Cells(36, 13).Value = Worksheets("Upデータ").Cells(i, 9).Value
End If
Next i
For i = 2 To x
If Worksheets("Upデータ").Cells(i, 8) = "坂本" Then
Worksheets("集計結果").Cells(37, 13).Value = Worksheets("Upデータ").Cells(i, 9).Value
End If
Next i
For i = 2 To x
If Worksheets("Upデータ").Cells(i, 8) = "橋本" Then
Worksheets("集計結果").Cells(38, 13).Value = Worksheets("Upデータ").Cells(i, 9).Value
End If
Next i
For i = 2 To x
If Worksheets("Upデータ").Cells(i, 8) = "田中" Then
Worksheets("集計結果").Cells(39, 13).Value = Worksheets("Upデータ").Cells(i, 9).Value
End If
Next i
For i = 2 To x
If Worksheets("Upデータ").Cells(i, 8) = "本田" Then
Worksheets("集計結果").Cells(40, 13).Value = Worksheets("Upデータ").Cells(i, 9).Value
End If
Next i
For i = 2 To x
If Worksheets("Upデータ").Cells(i, 8) = "その他" Then
Worksheets("集計結果").Cells(41, 13).Value = Worksheets("Upデータ").Cells(i, 9).Value
End If
Next i
Worksheets("集計結果").Cells(42, 13).Value = WorksheetFunction.Sum(Range(Cells(32, 13), Cells(42, 13)))
End Sub
Sub d()
With Worksheets("集計結果")
.Cells(32, 12).Value = "広瀬"
.Cells(33, 12).Value = "上田"
.Cells(34, 12).Value = "桜井"
.Cells(35, 12).Value = "飯田"
.Cells(36, 12).Value = "大村"
.Cells(37, 12).Value = "坂本"
.Cells(38, 12).Value = "橋本"
.Cells(39, 12).Value = "田中"
.Cells(40, 12).Value = "本田"
.Cells(41, 12).Value = "その他"
.Cells(42, 12).Value = "合計"
End With
End Sub
Sub 初めの手順に入れる()
Dim i As Long
Dim j As Long
Dim x As Long
x = Worksheets("Upデータ").Cells(Rows.Count, 2).End(xlUp).Row
Dim y As Long
y = Worksheets("作業種別シート").Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To x
For j = 2 To y
If Worksheets("Upデータ").Cells(i, 2) = Worksheets("作業種別シート").Cells(j, 1).Value Then
Worksheets("Upデータ").Cells(i, 5).Value = "桜井"
End If
Next j
Next i
For i = 2 To x
For j = 2 To y
If Worksheets("Upデータ").Cells(i, 2) = Worksheets("作業種別シート").Cells(j, 2).Value Then
Worksheets("Upデータ").Cells(i, 5).Value = "本田"
End If
Next j
Next i
For i = 2 To x
For j = 2 To y
If Worksheets("Upデータ").Cells(i, 2) = Worksheets("作業種別シート").Cells(j, 3).Value Then
Worksheets("Upデータ").Cells(i, 5).Value = "田中"
End If
Next j
Next i
'下のは修正必要
For i = 2 To x
If Worksheets("Upデータ").Cells(i, 5) = "" Then
Worksheets("Upデータ").Cells(i, 5).Value = "その他"
End If
Next i
'空欄の値を0にする
For i = 2 To x
If Worksheets("Upデータ").Cells(i, 4) = "" Then
Worksheets("Upデータ").Cells(i, 5).Value = ″″
End If
Next i
Author And Source
この問題について(VBAのコードです), 我々は、より多くの情報をここで見つけました https://qiita.com/kakakakakaooo111/items/96f4dff8914fc92e2549著者帰属:元の著者の情報は、元のURLに含まれています。著作権は原作者に属する。
Content is automatically searched and collected through network algorithms . If there is a violation . Please contact us . We will adjust (correct author information ,or delete content ) as soon as possible .