投稿/コメントを表示します。

発展編1 フォローメールセミナー
発展編1 フォローメールセミナー　第9回

わかやまさんの投稿

(投稿ID: 4189)

小川様

いつもありがとうございます。添削をお願いいたします。
Sub ikkini()
    sort1
    hontai
End Sub

Sub sort1()
Dim kazu As Long
Dim saigo As Long
Columns("A:G").Select
ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("main").Sort.SortFields.Add Key:=Range("B2:B317"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("main").Sort
.SetRange Range("A1:G317")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

saigo = Worksheets("main").Range("B65536").End(xlUp).Row
Worksheets("main").Range("A1").Value = "No."
For kazu = 2 To saigo
Worksheets("main").Range("A" & kazu).Value = kazu - 1
Next
End Sub[/code]
Sub syokyo()
    Dim ws As Worksheet
    For Each ws In Worksheets
        Application.DisplayAlerts = False
        If ws.Name = "main" Then
        ElseIf ws.Name = "main1" Then
        Else
            ws.Delete
        End If
        Application.DisplayAlerts = True
    Next
End Sub

Sub hontai()
    syokyo
    Dim gyo As Long
    Dim saigo1 As Long
    Dim wsmain As Worksheet
    Dim wsnow As Worksheet
    Dim gyosya As String
    Dim dt As Date
    Dim saki As Long
    Set wsmain = Worksheets("main")
    saigo1 = wsmain.Range("B65536").End(xlUp).Row
    For gyo = 2 To saigo1
        If gyosya <> wsmain.Range("B" & gyo).Value Then
            If gyo > 2 Then
                keisen
            End If
            Sheets("main1").Copy After:=Sheets(2)
            Sheets("main1 (2)").Name = wsmain.Range("B" & gyo).Value
            Set wsnow = ActiveSheet
            gyosya = wsnow.Name
            saki = 16
        End If
            wsnow.Range("F2").Value = wsnow.Name
            wsnow.Range("H" & saki).Value = wsmain.Range("F" & gyo).Value
            wsnow.Range("F" & saki).Value = wsmain.Range("E" & gyo).Value
            wsnow.Range("E" & saki).Value = wsmain.Range("D" & gyo).Value
            dt = wsmain.Range("C" & gyo).Value
            wsnow.Range("B" & saki).Value = Right(Year(dt), 2)
            wsnow.Range("C" & saki).Value = Month(dt)
            wsnow.Range("D" & saki).Value = Day(dt)
            If wsmain.Range("G" & gyo) > 0 Then
                wsnow.Range("I" & saki).Value = wsmain.Range("G" & gyo).Value
            ElseIf wsmain.Range("G" & gyo) < 0 Then
                wsnow.Range("J" & saki).Value = wsmain.Range("G" & gyo).Value
            End If
            If saki = 16 Then
                wsnow.Range("K" & saki) = wsmain.Range("G" & gyo).Value
            Else
                wsnow.Range("K" & saki) = wsmain.Range("G" & gyo).Value + wsnow.Range("K" & saki - 1)
            End If
            saki = saki + 1
    Next
    keisen
End Sub

Sub keisen()
    Dim saigo2 As Long
    Dim wsnow1 As Worksheet
    Set wsnow1 = ActiveSheet
    saigo2 = wsnow1.Range("B65536").End(xlUp).Row
    Range("B16:K" & saigo2).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
End Sub

2018/10/01 15:22