时间戳

首页 > 解决方案 > 查找标题并将整列复制到左侧 VBA

vba - 查找标题并将整列复制到左侧 VBA

问题描述

我的问题如下。

对于不同的客户（每张表都是一个客户），我有多张带有相同表格（价格）的表格。我必须每天通过将标价复制到更过时的价格左侧来更新价格列。

作为示例，请参见下图：

图像1

所以我需要复制最后一行（z-sprd）并插入到最后一个可用日期的左侧（下图中是 2018 年 6 月 11 日）。到现在为止，我能够遍历工作表，找到 z-sprd 列并在某个地方通过它。我现在需要的是找到具有最新价格的列（在本例中为 2018 年 6 月 11 日），我通过在工作表中放置一个用户表单来完成此操作，然后将列插入并越过其左侧。

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

标签： vbaexcel

解决方案

我想出的解决方案是这个：

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

该代码有效，现在我只需将列格式化为与其他列相同。我希望有人会觉得它有帮助。干杯。

推荐阅读