查找标题并将整列复制到左侧的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

该代码有效，现在我只需要将该列的格式设置为与其他列相同即可。 我希望有人会有所帮助。 干杯。