根据搜索文本获取列位置并移动

Question

我需要始终确保 name 在 C 列中，address 在 D 列中。我使用下面的语法来扫描 header 文本并确定每个 header 所在的列位置，但如果 header 文本不符合强制位置，将其移动到正确位置的语法是什么？

Sub SearchForText()
    Dim strSearch As String,  aCell As Range, strSearch1 As String
    Dim aCell1 As Range, namecolumn As Int, addresscolumn As Int

    strSearch = "Name"  

    Set aCell = Sheet1.Rows(1).Find(What:=strSearch, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    GetColumnName(aCell.Column)
    namecolumn = GetColumnName()

    strSearch1 = "Address"

    Set aCell = Sheet1.Rows(1).Find(What:=strSearch1, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    GetColumnName(aCell1.Column)
    addresscolumn = GetColumnName()

    if namecolumn <> 3 THEN
        'How to copy column to be position 3?
    end if

    if addresscolumn <> 4 THEN
        'How to copy column to be position 4?
    end if
End Sub
Function GetColumnName(colNum As Integer) As String
    Dim d As Integer
    Dim m As Integer
    Dim name As String
    d = colNum
    name = ""
    Do While (d > 0)
        m = (d - 1) Mod 26
        name = Chr(65 + m) + name
        d = Int((d - m) / 26)
    Loop
    GetColumnName = name
End Function

Answer 1

基本上，你需要的是：-

With aCell
    Sheet1.Cells(1, 3).Value = .Value
    .Value = ""
End With

因为您的 Find 函数在 aCell 中找到了 "Name"，所以上面的代码从 aCell 复制到第 3 列 ("C") 并将其删除。请注意，Cell 始终定义为 Cells([Row], [Column])。列属性首选数字，但字母也可以。

顺便说一句，不要费心将列号转换为列名，因为 Excel 只理解数字并将您的名称转换回数字。

Columns("AL").Column    ' returns the column number of column "AL"
Columns(155).Address     ' returns $EY:$EY

Answer 2

我会简单地移动值，如下所示：

Sub Test()
    Dim colIndex As Long

    With Worksheets("Sheet1")
        CheckColumn .Rows(1), "Name", 3
        CheckColumn .Rows(1), "Address", 4
    End With
End Sub

Sub CheckColumn(rngHeaderRow As Range, colName As String, refColumnIndex As Long)
    Dim columnIndex As Long
    With rngHeaderRow.Parent
        If GetColumnIndex(rngHeaderRow, colName, columnIndex) Then If columnIndex <> refColumnIndex Then MoveValues .Columns(columnIndex), .Columns(refColumnIndex)
    End With
End Sub

Function GetColumnIndex(rngHeaderRow As Range, colName As String, columnIndex As Long) As Boolean
    Dim rng As Range

    Set rng = rngHeaderRow.Find(What:=colName, LookIn:=xlValues, lookat:=xlWhole)
    If Not rng Is Nothing Then
        columnIndex = rng.Column
        GetColumnIndex = True
    End If
End Function

Sub MoveValues(colToMoveFrom As Range, colToMoveTo As Range)
    Dim arr As Variant
    Dim maxSize As Long

    ResizeColumn colToMoveFrom
    ResizeColumn colToMoveTo
    maxSize = WorksheetFunction.Max(colToMoveFrom.Count, colToMoveTo.Count)
    With colToMoveFrom.Parent.UsedRange
        arr = Application.Transpose(colToMoveFrom.Resize(maxSize))
        colToMoveFrom.Resize(maxSize).Value = colToMoveTo.Resize(maxSize).Value
        colToMoveTo.Resize(maxSize).Value = Application.Transpose(arr)
    End With
End Sub

Sub ResizeColumn(rng As Range)
    With rng.Parent
        Set rng = .Range(rng.Cells(1, 1), .Cells(.Rows.Count, rng.Column).End(xlUp))
    End With
End Sub

根据搜索文本获取列位置并移动

Get Column Position Based Off Search Text & Move

excel

vba

excel-2013