受講生 さん:

こっちは、さっき回答差し上げたものと同じでしょうか？
であれば、回答省略します。もし何かあればお知らせください！



> 小川先生
> 大変お世話になっております。
> ファイルを壊れて申し訳ないです。
> 内容は下記になります。
> Sub continueworks()
> Call sheetdelet
> Call getnumber
> Call companynamesort
> Call madedenpyo
> Call numberreturn
> End Sub
> Sub sheetdelet()
> Dim ss As Worksheet
> Application.DisplayAlerts = False
> For Each ss In Worksheets
> If Left((ss.Name), 4) <> "main" Then
> ss.Delete
> End If
> Next
> Application.DisplayAlerts = True
> End Sub
> Sub getnumber()
> Dim bango As Long
> Dim lastrow As Long
> lastrow = Range("b65536").End(xlUp).Row
> For bango = 2 To lastrow
> Worksheets("main").Range("a" & bango).Value = bango - 1
> Next
> Worksheets("main").Range("a1").Value = "No."
> End Sub
> Sub companynamesort()
> Worksheets("main").Range("A1:G317").Sort _
> key1:=Range("b2"), _
> Order1:=xlAscending, _
> Header:=xlYes
> Range("B2").Select
> End Sub
> Sub numberreturn()
> Worksheets("main").Range("A1:G317").Sort _
> key1:=Range("a2"), _
> Order1:=xlAscending, _
> Header:=xlYes
> Range("B2").Select
> End Sub
> Sub madedenpyo()
> '手順１：mainシートをコーピ作成
> '手順２：新シート名を付ける
> '手順３：新シートのRangeB～RnageKまで内容伝記
> '手順４：for Nextですべての会社名のシート作成
> '手順５：罫線作成
> Dim n As String
> Dim ctn As Long
> Dim bango As Long
> Dim lastrow As Long
> Dim dt As Date
> Dim st As Worksheet
> Dim ss As Worksheet
> Set ss = Worksheets("main")
> lastrow = ss.Range("b65536").End(xlUp).Row
> For bango = 2 To lastrow
> If n <> ss.Range("b" & bango - 1).Value Then
> If bango > 2 Then
> '罫線作成タイミングは新規シート追加される手前
> Call keisen
> End If
> n = ss.Range("b" & bango).Value
> Sheets("main1").Select
> Sheets("main1").Copy After:=Sheets(2)
> Set st = ActiveSheet
> st.Name = n
> ctn = 16
> End If
> dt = ss.Range("c" & bango).Value
> st.Range("e" & ctn).Value = ss.Range("D" & bango).Value
> st.Range("f" & ctn).Value = ss.Range("e" & bango).Value
> st.Range("h" & ctn).Value = ss.Range("f" & bango).Value
> If ss.Range("g" & bango).Value > 0 Then
> st.Range("i" & ctn).Value = ss.Range("g" & bango).Value
> Else
> st.Range("j" & ctn).Value = ss.Range("g" & bango).Value
> End If
>
> st.Range("b" & ctn).Value = Right(Year(dt), 2)
> st.Range("c" & ctn).Value = Month(dt)
> st.Range("d" & ctn).Value = Day(dt)
>
> ctn = ctn + 1
> Next
> 'ラスト伝票の罫線作成
> Call keisen
> ss.Activate
> End Sub
>
> Sub keisen()
> Dim lr As Long
> lr = Range("h65536").End(xlUp).Row
> Range("B16:K" & lr + 1).Select
> Selection.Borders(xlDiagonalDown).LineStyle = xlNone
> Selection.Borders(xlDiagonalUp).LineStyle = xlNone
> With Selection.Borders(xlEdgeLeft)
> .LineStyle = xlContinuous
> .ColorIndex = 0
> .TintAndShade = 0
> .Weight = xlThin
> End With
> With Selection.Borders(xlEdgeTop)
> .LineStyle = xlContinuous
> .ColorIndex = 0
> .TintAndShade = 0
> .Weight = xlThin
> End With
> With Selection.Borders(xlEdgeBottom)
> .LineStyle = xlContinuous
> .ColorIndex = 0
> .TintAndShade = 0
> .Weight = xlThin
> End With
> With Selection.Borders(xlEdgeRight)
> .LineStyle = xlContinuous
> .ColorIndex = 0
> .TintAndShade = 0
> .Weight = xlThin
> End With
> With Selection.Borders(xlInsideVertical)
> .LineStyle = xlContinuous
> .ColorIndex = 0
> .TintAndShade = 0
> .Weight = xlThin
> End With
> With Selection.Borders(xlInsideHorizontal)
> .LineStyle = xlContinuous
> .ColorIndex = 0
> .TintAndShade = 0
> .Weight = xlThin
> End With
> End Sub
>
>
>
> 大変お手数ですが、どうぞよろしくお願いいたします。

2018/01/06 02:16