実験用ブログ

・勉強したことをメモしておく

すごろくメモ5

2019-02-20 01:57:46 | 勉強
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

Sub テスト()
ActiveSheet.Shapes("メッセージエリア").Select
For i = 1 To 30
Selection.ShapeRange.ScaleWidth 1.05, msoFalse, msoScaleFromMiddle
Sleep 5
DoEvents
Next i
Sleep 100
DoEvents
For i = 1 To 30
Selection.ShapeRange.ScaleWidth 0.95, msoFalse, msoScaleFromMiddle
Sleep 5
DoEvents
Next i
Cells(1, 1).Select
End Sub

すごろくメモ4

2019-02-03 21:13:03 | 勉強
Dim currentWeek As String
currentWeek = ""

'先週までの集計
lastWeekScore = 0
For currentRow = 16 To lastRow
tmpWeek = ActiveSheet.Cells(currentRow, 12)
If tmpWeek <> "" Then
ret = Filter(weekList, tmpWeek)
If UBound(ret) <> -1 Then
currentWeek = tmpWeek
End If
End If

'今週の行に到達したところで、先週までの集計は終了
If currentWeek = week Then
Exit For
End If

'第1週に到達したところから集計開始(第1週より上の行はスキップ)
If currentWeek <> "" Then
lastWeekScore = lastWeekScore + ActiveSheet.Cells(currentRow, scoreClm).Value
End If
Next currentRow

'今週の集計
thisWeekScore = 0
For currentRow = currentRow To lastRow
tmpWeek = ActiveSheet.Cells(currentRow, 12)
If tmpWeek <> "" Then
ret = Filter(weekList, tmpWeek)
If UBound(ret) <> -1 Then
currentWeek = tmpWeek
End If
End If

'今週の行が終わったところで、今週の集計は終了
If currentWeek <> week Then
lastWeekScore = lastWeekScore + ActiveSheet.Cells(currentRow, scoreClm).Value
End If
Next currentRow
MsgBox lastWeekScore