查找標題並將整列復制到左側的VBA

Question

我的問題如下。

我有多個具有不同客戶相同表（價格）的工作表（每個工作表都是一個客戶）。 我必須每天通過將定價復制到過時價格的左側來更新價格列。

例如，請參見下圖：

圖片1

因此，我需要復制最后一行（z-sprd）並插入到最后可用日期的左側（下圖中是6/11/2018）。 到目前為止，我仍然可以循環瀏覽工作表，找到z-sprd列並將其粘貼到某個位置。 我現在需要的是找到具有最新價格的列（在本例中為6/11/2018），這是通過在表格中放置一個用戶表單，然后在該列的左側插入並通過它來完成的。

Sub Sample()
    Dim ws As Worksheet
    Dim aCell As Range
    Dim bCell As Range
    Dim col As Long, lRow As Long
    Dim colName As String
    Dim i As Integer

    'Start of the VBA loop
    For i = 1 To Worksheets.Count

    Set ws = ThisWorkbook.Sheets(i)
    'Here i put the latest date, such as 6/11/2018, and then i find it in AC8
    Set bCell = Sheet1.UsedRange.Find(what:=Sheet1.Range("AC8").Value, LookIn:=xlValues, LookAt:=xlWhole, _
                    MatchCase:=False, SearchFormat:=False)
                    bCell.Copy Range("AD8")

    With ws
        Set aCell = .Range("Table").Find(what:="Z-Sprd (bp)", LookIn:=xlValues, LookAt:=xlWhole, _
                    MatchCase:=False, SearchFormat:=False)

    '~~> Copy the entire column
    aCell.EntireColumn.Copy


    '~~> Insert the column here
    With ws
       .Columns("AR:AR").PasteSpecial xlPasteValues
       .Columns("AR:AR").Resize(.Rows.Count - 1, 1).Offset(1, 0).NumberFormat = "0.0"
       bCell.Copy ws.Range("AR7")
       ws.Range("AR7") = ws.Range("AR7") + 7

    End With
    End With

    Next i

End Sub 

Answer 1

我想出的解決方案是：

Option Explicit


Sub LastPrices()
    Dim ws As Worksheet
    Dim aCell As Range
    Dim bCell As Range
    Dim selrange As Range
    Dim i As Integer
    Dim colnum As Integer, rownum As Integer
    Dim prj As Object
    Dim not_use As Variant


    Set prj = ActiveWorkbook.VBProject
    'Start of the VBA loop

    not_use = Array(2, 7, 8, 9, 10, 11) ' create an array

    For i = 1 To Worksheets.Count
        If IsError(Application.Match(i, not_use, 0)) Then

    Set ws = Worksheets(prj.VBComponents("Sheet" & i).Properties("Index").Value)
    'Set ws = ThisWorkbook.Sheets(i)

    Set bCell = Sheet11.Range("A1")

    With ws
        Set aCell = .Range("Table").Find(what:="Z-Sprd (bp)", LookIn:=xlValues, lookat:=xlWhole, _
                    MatchCase:=False, SearchFormat:=False)

    'look for the row number and column number
    colnum = ws.UsedRange.Find(what:=Sheet11.Range("A1"), lookat:=xlWhole).Column
    rownum = ws.UsedRange.Find(what:=Sheet11.Range("A1"), lookat:=xlWhole).Row

    ws.Columns(colnum).Insert Shift:=xlToRight
    '~~> Copy the entire column
    aCell.EntireColumn.Copy

    'Set the column range to work with
    Set selrange = ws.Columns(colnum)

    '~~> Insert the column here
    With ws
       .Columns(colnum).PasteSpecial xlPasteValues
       .Columns(colnum).Resize(.Rows.Count - 1, 1).Offset(1, 0).NumberFormat = "0.0"
       bCell.Copy ws.Cells(rownum, colnum)
       ws.Cells(rownum, colnum) = ws.Cells(rownum, colnum) + 7

    End With
    End With
    End If
    Next i

End Sub

該代碼有效，現在我只需要將該列的格式設置為與其他列相同即可。 我希望有人會有所幫助。 干杯。