Sub UpdateData()
If MsgBox("本当に実行しますか？", _
vbExclamation + _
vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
Range("C4:C23").Value = Range("D4:D23").Value
Range("D4:D23").ClearContents
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge= 1 Then
If Target.Row >= 3 And _
Target.Row <= 5 And _
Target.Column = 1 Then
Dim tR As Long, lR As Long
tR = Target.Row
lR = Cells(Rows.Count, "A").End(xlUp).Row + 1
Range(Cells(lR, "B"), Cells(lR, "D")).Value = _
Range(Cells(tR, "B"), Cells(tR, "D")).Value
End If
End If
End Sub
では、コードについて解説していきます。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge= 1 Then
'省略
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Range("A2").Value = "ID" Then
Dim taskCnt As Long
Dim compCnt As Long
taskCnt = _
WorksheetFunction.CountA(Sh.Range("A3:A10000"))
compCnt = _
WorksheetFunction.CountIf(Sh.Range("D3:D10000"), "完了")
If taskCnt = compCnt Then
Sh.Name = Sh.Range("A1").Value
Else
Sh.Name = Sh.Range("A1").Value & _
"(" & (taskCnt - compCnt) & ")"
End If
End If
End Sub
では、コードについて解説していきます。
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Range("A2").Value = "ID" Then
'省略
End If
End Sub
Dim taskCnt As Long
Dim compCnt As Long
taskCnt = _
WorksheetFunction.CountA(Sh.Range("A3:A10000"))
compCnt = _
WorksheetFunction.CountIf(Sh.Range("D3:D10000"), "完了")
Private Sub Worksheet_Change(ByVal Target As Range)
Me.Protect UserInterfaceOnly:=True
Dim r As Range
For Each r In Target
If r.Value <> "" Then
r.Locked = True
End If
Next r
End Sub
では、コードについて解説していきます。
Private Sub Worksheet_Change(ByVal Target As Range)
Me.Protect UserInterfaceOnly:=True
'省略
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge = 1 And _
Target.Row >= 3 And _
Target.Column = 2 Then
Application.EnableEvents = False
Dim lRow As Long
lRow = Cells(Rows.Count, "B").End(xlUp).Row
On Error Resume Next
Range("B3", Cells(lRow, "B")). _
SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
On Error GoTo 0
Application.EnableEvents = True
End If
End Sub
では、コードについて解説していきます。
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge = 1 And _
Target.Row >= 3 And _
Target.Column = 2 Then
'省略
End If
End Sub
Dim lRow As Long
lRow = Cells(Rows.Count, "B").End(xlUp).Row
On Error Resume Next
Range("B3", Cells(lRow, "B")). _
SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
On Error GoTo 0
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("商品管理")
Set ws2 = Worksheets("請求書")
If Target.CountLarge = 1 And _
Target.Row >= 5 And Target.Row <= 10 And _
Target.Column = 2 Then
ws2.Cells(Target.Row, "C").ClearContents
ws2.Cells(Target.Row, "D").ClearContents
Dim lRow As Long
lRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
Dim i As Long
For i = 2 To lRow
If ws1.Cells(i, "A").Value = Target.Value Then
ws2.Cells(Target.Row, "C").Value = _
ws1.Cells(i, "B").Value
ws2.Cells(Target.Row, "D").Value = _
ws1.Cells(i, "C").Value
Exit For
End If
Next i
End If
End Sub
では、コードについて解説していきます。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("商品管理")
Set ws2 = Worksheets("請求書")
If Target.CountLarge = 1 And _
Target.Row >= 5 And Target.Row <= 10 And _
Target.Column = 2 Then
'省略
End If
End Sub
If ws1.Cells(i, "A").Value = Target.Value Then
ws2.Cells(Target.Row, "C").Value = _
ws1.Cells(i, "B").Value
ws2.Cells(Target.Row, "D").Value = _
ws1.Cells(i, "C").Value
Exit For
End If
