在特定列之后添加/插入新列，并在该新列中应用公式

Question

我正在尝试查找一个特定列，然后添加或插入一个名为"的新列；响应时间"；在那列之后。

然后在新添加的列中应用减去两列的公式；在内陆或中转点(目的地(找到满员门_实际"；以及"；内陆或临时点(目的地(的全出门_recvd"；在新添加的名为"；响应时间"；。

Sub addt()
Dim LastRow As Long
Dim LastCol As Long
Dim iRow As Long
Dim wsh As Worksheets
Dim i As Long
Dim cl As Range

Dim col1 As Long, col2 As Long, col As Long

With ActiveWorkbook.Worksheets("OutPut")
'Find Full Out Gate at Inland or Interim Point (Destination)_actual
'Full Out Gate at Inland or Interim Point (Destination)_recvd

With ActiveWorkbook.Worksheets("OutPut")

For Each cl In Range("1:1")
If cl = "Full Out Gate at Inland or Interim Point (Destination)_recvd" Then
cl.EntireColumn.Insert shift:=xlRight
End If
cl.Offset(0, 1) = "Response Time"
Next cl

' Copy Header Fromat
.Cells(1, cl).Copy
.Cells(1, cl + 1).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False

With ActiveWorkbook.Worksheets("OutPut")

col1 = .Cells.Find(What:="Full Out Gate at Inland or Interim Point (Destination)_actual", _
After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Column

col2 = .Cells.Find(What:="Full Out Gate at Inland or Interim Point (Destination)_recvd", _
After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Column

' Apply Formula to "Response Time" column range
For i = 2 To cl
.Cells(i, cl + 1).Formula = .Cells(i, col2) - .Cells(i, col1)
.Cells(i, cl + 1).NumberFormat = "hh:mm:ss"
Next i

End With

End With

End With

ActiveWorkbook.Worksheets("OutPut").UsedRange.Columns.AutoFit
End Sub

Answer 1

请尝试下一个更新的代码：

Sub addt()
Dim lastR As Long, cl As Range, col1 As Long
'Find Full Out Gate at Inland or Interim Point (Destination)_actual
'Full Out Gate at Inland or Interim Point (Destination)_recvd
With ActiveWorkbook.Worksheets("OutPut")
For Each cl In .Range("1:1")
If cl.Value = "Full Out Gate at Inland or Interim Point (Destination)_recvd" Then               
cl.Offset(0, 1).EntireColumn.Insert Shift:=xlRight
cl.Offset(0, 1) = "Response Time"
cl.Copy
cl.Offset(0, 1).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Exit For ' exit the loop after finding the column
End If
Next cl

With ActiveWorkbook.Worksheets("OutPut")
col1 = .cells.Find(What:="Full Out Gate at Inland or Interim Point (Destination)_actual", _
After:=.Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Column
If col1 = 0 Then MsgBox "The column header could not be found...": Exit Sub
lastR = .cells(rows.count, cl.Column).End(xlUp).row 'last row 
'put formula (at once):
.With .Range(cl.Offset(1, 1), .cells(lastR, cl.Offset(1, 1).Column))
.Formula = "=" & cl.Offset(1, 0).Address(0, 0) & "-" & .cells(2, col1).Address(0, 0)
.NumberFormat = "hh:mm:ss"
End With
End With
.UsedRange.Columns.AutoFit
End With
End Sub