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

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

受講生さんの投稿

(投稿ID: 5004)

提出いたします。

Option Explicit
Dim S_main As Worksheet
Dim S_hina As Worksheet
Dim saigo As Long
Sub zentai()
Set S_main = Worksheets("main")
Set S_hina = Worksheets("main1")
saigo = S_main.Range("B65536").End(xlUp).Row
anum
bnara
fuyokeshi
tenki '中にkeisen
anara
End Sub
Sub anum()
Dim n As Long
For n = 2 To saigo
S_main.Range("A" & n).Value = n - 1
Next
End Sub

Sub bnara()
Range("A1:G317").Sort _
key1:=Range("B1"), _
Order1:=xlAscending, _
Header:=xlYes
End Sub

Sub anara()
Range("A1:G317").Sort _
key1:=Range("A1"), _
Order1:=xlAscending, _
Header:=xlYes
End Sub
Sub fuyokeshi()
Application.DisplayAlerts = False
Dim ws As Worksheet
For Each ws In Worksheets
If Left(ws.Name, 4) <> "main" Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
Sub tenki()
Dim mgyo As Long
Dim mtori As String
Dim S_copy As Worksheet
Dim copygyo
Dim dt As Date
For mgyo = 2 To saigo
mtori = S_main.Range("B" & mgyo).Value
If mtori <> S_main.Range("B" & mgyo - 1).Value Then
If mgyo > 2 Then
keisen
End If
copygyo = 16
S_hina.Copy after:=Sheets(2)
Set S_copy = ActiveSheet
S_copy.Name = mtori
End If
S_copy.Range("E" & copygyo).Value = S_main.Range("D" & mgyo).Value
S_copy.Range("F" & copygyo).Value = S_main.Range("E" & mgyo).Value
S_copy.Range("H" & copygyo).Value = S_main.Range("F" & mgyo).Value
dt = S_main.Range("C" & mgyo).Value
S_copy.Range("B" & copygyo).Value = Right(Year(dt), 2)
S_copy.Range("C" & copygyo).Value = Month(dt)
S_copy.Range("D" & copygyo).Value = Day(dt)
If S_main.Range("G" & mgyo).Value > 0 Then
S_copy.Range("J" & copygyo).Value = S_main.Range("G" & mgyo).Value
Else
S_copy.Range("I" & copygyo).Value = S_main.Range("G" & mgyo).Value
End If
If copygyo = 16 Then
S_copy.Range("K" & copygyo).Value = S_main.Range("G" & mgyo).Value
Else
S_copy.Range("K" & copygyo).Value = S_main.Range("G" & mgyo).Value + S_copy.Range("K" & copygyo - 1).Value
End If
copygyo = copygyo + 1
Next
keisen
S_main.Select
End Sub
Sub keisen()
Dim copysaigo As Long
copysaigo = Range("B65536").End(xlUp).Row
With Range("B16:K" & copysaigo)
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End With
End Sub
2021/02/01 07:20