代码之家 › 专栏 › 技术社区 › Iron Man

代码插入和复制到错误的工作表

vba excel

Iron Man · 技术社区 · 4 月前

每次我运行此代码时,它都会从列“A”开始将列移动并插入到表1中。我完全不明白为什么。将在ThisWorkbook中添加一行限制此内容。工作表是否解决了问题?

Sub ArrangeCoreColumns()
    Dim ColOrder As Variant, idx As Integer
    Dim Fnd    As Range, count As Integer
    
        ColOrder = Array("route", "vrId", "carrier", "trailerNumber", "scheduledDepartureTime", "trailerId", "sealId", "label")
        count = 1
    
    Application.ScreenUpdating = False
    
    With Sheet8
        
        For idx = LBound(ColOrder) To UBound(ColOrder)
            Set Fnd = .Rows("1:1").Find(ColOrder(idx), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
            If Not Fnd Is Nothing Then
                If Fnd.Column <> count Then
                    Fnd.EntireColumn.Cut
                    Columns(count).Insert shift:=xlToRight
                    Application.CutCopyMode = False
                End If
                count = count + 1
            End If
        Next idx
    End With
    
    With Sheet8
        .Range("A1").value = "Lane"
        .Range("B1").value = "VRID"
        .Range("C1").value = "Carrier"
        .Columns("D:D").Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("D1").value = "Trailer #"
        .Range("F1").value = "SDT"
        .Range("G1").value = "Trailer ID"
        .Range("H1").value = "Seal #"
        .Range("I1").value = "Dock Door"
    End With
    
    With Sheet8
        .Range("D2").Formula = "=IFERROR(REPLACE(E2,1,FIND(""AZNG "",E2)+4,),"""")"
    End With
    
    With Sheet8
        '.Range("D2").AutoFill Destination:=Range("D2:D500")
        .Range("D2").Copy Destination:=.Range("D3:D500")
        .Range("A:I").Columns.AutoFit
    End With
    
    Application.ScreenUpdating = True
    
    Call TM_Formulas
    
End Sub

1 回复 | 直到 4 月前

Michal 4 月前

你好像不见了 . 从 Columns(count).Insert shift:=xlToRight 。您还可以删除冗余项 With 使其更具可读性的语句:

Sub ArrangeCoreColumns()
    Dim ColOrder As Variant, idx As Integer
    Dim Fnd As Range, count As Integer
    Dim ws As Worksheet
    
    ColOrder = Array("route", "vrId", "carrier", "trailerNumber", "scheduledDepartureTime", "trailerId", "sealId", "label")
    count = 1
    Set ws = Sheet8
    
    Application.ScreenUpdating = False
    
    With ws
        For idx = LBound(ColOrder) To UBound(ColOrder)
            Set Fnd = .Rows("1:1").Find(ColOrder(idx), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
            If Not Fnd Is Nothing Then
                If Fnd.Column <> count Then
                    Fnd.EntireColumn.Cut
                    .Columns(count).Insert shift:=xlToRight
                    Application.CutCopyMode = False
                End If
                count = count + 1
            End If
        Next idx
        
        .Range("A1").Value = "Lane"
        .Range("B1").Value = "VRID"
        .Range("C1").Value = "Carrier"
        .Columns("D:D").Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("D1").Value = "Trailer #"
        .Range("F1").Value = "SDT"
        .Range("G1").Value = "Trailer ID"
        .Range("H1").Value = "Seal #"
        .Range("I1").Value = "Dock Door"
        
        .Range("D2").Formula = "=IFERROR(REPLACE(E2,1,FIND(""AZNG "",E2)+4,),"""")"
        .Range("D2").Copy Destination:=.Range("D3:D500")
        .Range("A:I").Columns.AutoFit
    End With
    
    Application.ScreenUpdating = True
    
    Call TM_Formulas
End Sub