| Option Explicit |
| Public Data As String |
| Public RowCount As Long |
| Public EndRow As Long |
| Public EndRowZ As Long |
| Public PlusRow As Long |
| Public PlusRowz As String |
| Public i As Long |
| Public r As Long |
| Sub ファイル選択() |
| Range("B4:B5").ClearContents |
| MsgBox ("ファイルを選択してください") |
| With Application.FileDialog(msoFileDialogFilePicker) |
| .Title = "ファイル選択" |
| .ButtonName = "ファイル選択" |
| .Show |
| Range("b4") = (Left(.InitialFileName, Len(.InitialFileName) - 1)) |
| For Each vrtselecteditem In .SelectedItems |
| Range("b5") = Mid(vrtselecteditem, Len(.InitialFileName) + 1) |
| Next |
| End With |
| End Sub |
| Sub データコピー() |
| Data = Range("B4").Value & "\" & Range("B5").Value |
| Workbooks.Open Data |
| Cells.Select |
| Selection.Copy |
| ThisWorkbook.Worksheets("作業用").Activate |
| Range("A1").PasteSpecial Paste:=xlPasteValues |
| End Sub |
| Sub 不要行削除() |
| RowCount = 1048576 |
| Range("1:7").Delete |
| Range("A1").AutoFilter field:=6, Criteria1:="" |
| If Cells(RowCount, 1).End(xlUp).Row <> 1 Then |
| Range("a2:o2").Select |
| Range(Selection, Selection.End(xlDown)).Select |
| Selection.Delete (xlShiftUp) |
| End If |
| ActiveSheet.ShowAllData |
| Range("A1").AutoFilter field:=5, Criteria1:="0" |
| If Cells(RowCount, 1).End(xlUp).Row <> 1 Then |
| Range("a2:o2").Select |
| Range(Selection, Selection.End(xlDown)).Select |
| Selection.Delete (xlShiftUp) |
| End If |
| ActiveSheet.ShowAllData |
| End Sub |
| Sub 工程縦列化() |
| Range("p2").Formula = "=counta(f2:o2)-1" |
| RowCount = 1048576 |
| EndRow = Cells(RowCount, 1).End(xlUp).Row |
| Range("p2").Select |
| Selection.Copy |
| Cells(EndRow, 16).Select |
| Range(Selection, Selection.End(xlUp)).Select |
| Selection.PasteSpecial Paste:=xlPasteFormulas |
| EndRowZ = EndRow + WorksheetFunction.Sum(Range(Cells(2, 16), Cells(EndRow, 16))) |
| For i = 2 To EndRowZ |
| PlusRow = Cells(i, 16) |
| If PlusRow > 0 Then |
| r = i + 1 |
| PlusRow = PlusRow + i |
| Range(Rows(r), Rows(PlusRow)).Insert |
| End If |
| Next |
| For i = 2 To EndRowZ |
| PlusRowz = Cells(i, 16) |
| If PlusRowz <> "" Then |
| Cells(i, 6).Select |
| Range(Selection, Selection.End(xlToRight)).Select |
| Selection.Copy |
| Cells(i, 17).PasteSpecial xlPasteAll, Transpose:=True |
| End If |
| Next |
| End Sub |