Dim ws As Worksheet
Dim searchValue As String
Dim updateValue As String
Dim searchRange As Range
Dim cell As Range
Dim found As Range
Dim today As String
Dim lastUpdatedCell As Range

‘ シートを設定
Set ws = ThisWorkbook.Sheets(“Sheet1”) ‘ シート名を変更してください

‘ 検索する値と更新する値を取得
searchValue = ws.Range(“G2”).Value
updateValue = ws.Range(“G3”).Value
today = Format(Date, “yyyy/mm/dd”)

‘ E列の検索範囲を設定
Set searchRange = ws.Range(“E:E”)

‘ 検索
Set found = searchRange.Find(What:=searchValue, LookIn:=xlValues, LookAt:=xlWhole)

If Not found Is Nothing Then
firstAddress = found.Address
Do
‘ G列を更新
ws.Cells(found.Row, “G”).Value = updateValue

‘ F列に本日の日付を記入
ws.Cells(found.Row, “F”).Value = today

‘ 最後に更新したセルを記録
Set lastUpdatedCell = ws.Cells(found.Row, “G”)

‘ 次を検索
Set found = searchRange.FindNext(found)
Loop While Not found Is Nothing And found.Address <> firstAddress
End If

‘ G2とG3の値を消去
ws.Range(“G2”).ClearContents
ws.Range(“G3”).ClearContents

‘ 最後に更新したセルをアクティブセルに設定
If Not lastUpdatedCell Is Nothing Then
lastUpdatedCell.Select
End If

 

 

Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastRow1 As Long
Dim lastRow2 As Long
Dim copyRange As Range

‘ シートを設定
Set ws1 = ThisWorkbook.Sheets(“Sheet1”)
Set ws2 = ThisWorkbook.Sheets(“Sheet2”)

‘ Sheet1の最終行を取得
lastRow1 = ws1.Cells(ws1.Rows.Count, “B”).End(xlUp).Row

‘ B5から値がある最終行までの範囲を取得
Set copyRange = ws1.Range(“B5:K” & lastRow1)

‘ Sheet2の最終行を取得
lastRow2 = ws2.Cells(ws2.Rows.Count, “B”).End(xlUp).Row + 1

‘ コピーして貼り付け
copyRange.Copy Destination:=ws2.Range(“B” & lastRow2)
End Sub

 

 

Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim j As Long
Dim dict As Object
Set dict = CreateObject(“Scripting.Dictionary”)

‘ シートを設定
Set ws = ThisWorkbook.Sheets(“Sheet1”) ‘ シート名を適宜変更してください

‘ 最終行を取得
lastRow = ws.Cells(ws.Rows.Count, “J”).End(xlUp).Row

‘ 辞書を使ってJ列の値をキーに、H列の合計を計算
For i = 2 To lastRow ‘ ヘッダーがあると仮定しています。ヘッダーがない場合は1から始めてください
Dim key As String
key = ws.Cells(i, “J”).Value
If dict.exists(key) Then
dict(key) = dict(key) + ws.Cells(i, “H”).Value
Else
dict.Add key, ws.Cells(i, “H”).Value
End If
Next i

‘ J列の値が同じ行を削除し、最初の行にH列の合計を記入
For i = lastRow To 2 Step -1 ‘ ヘッダーがあると仮定しています
key = ws.Cells(i, “J”).Value
If dict.exists(key) Then
If dict(key) = “Merged” Then
ws.Rows(i).Delete
Else
ws.Cells(i, “H”).Value = dict(key)
dict(key) = “Merged”
End If
End If
Next i

‘ 辞書をクリア
Set dict = Nothing

 

 

=IF((G7-G6)*1440>=14,”オーバー”,””)

 

Dim ws As Worksheet
Dim searchValue As String
Dim updateValue As String
Dim useDate As String
Dim searchRange As Range
Dim found As Range
Dim lastUpdatedCell As Range
Dim dateInput As String

‘ シートを設定
Set ws = ThisWorkbook.Sheets(“Sheet1”) ‘ シート名を変更してください

‘ 初期使用日を本日に設定
useDate = Format(Date, “yyyy/mm/dd”)

Do
‘ ユーザーにG2の値を入力させる
searchValue = InputBox(“E列で検索する値を入力してください(終了するにはキャンセルを押してください)”, “検索値入力”)
If searchValue = “” Then Exit Sub ‘ キャンセルまたは空白の場合は終了

‘ ユーザーにG3の値を入力させる
updateValue = InputBox(“一致した行のG列に記入する値を入力してください”, “更新値入力”)
If updateValue = “” Then Exit Sub ‘ キャンセルまたは空白の場合は終了

‘ 使用日を入力(空白なら変更なし)
dateInput = InputBox(“使用日を入力してください(yyyy/mm/dd形式)。空白の場合は” & useDate & “が使用されます。”, “使用日入力”)
If dateInput <> “” Then useDate = dateInput ‘ 入力があれば使用日を更新

‘ E列の検索範囲を設定
Set searchRange = ws.Range(“E:E”)

‘ 検索
Set found = searchRange.Find(What:=searchValue, LookIn:=xlValues, LookAt:=xlWhole)

If Not found Is Nothing Then
firstAddress = found.Address
Do
‘ G列を更新
ws.Cells(found.Row, “G”).Value = updateValue

‘ F列に使用日を記入
ws.Cells(found.Row, “F”).Value = useDate

‘ 最後に更新したセルを記録
Set lastUpdatedCell = ws.Cells(found.Row, “G”)

‘ 次を検索
Set found = searchRange.FindNext(found)
Loop While Not found Is Nothing And found.Address <> firstAddress
End If

‘ 最後に更新したセルをアクティブセルに設定
If Not lastUpdatedCell Is Nothing Then
lastUpdatedCell.Select
End If

Loop ‘ ループして次の入力を待つ