Question

我很难让VBA在搜索列后按名称选择整个列（可以包含非连续数据）。

' Select the first row
Rows("1:1").Select

Selection.Find(What:="LongColumnName", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
    xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Selection.End(xlUp).Select

问题是在找到单元格之后，选择仍然是整行1 。在我有选定的列后，我将它移到前面，并将为多个列执行此操作。最后，我将插入列并在列值之间进行一些比较。

由于

Answer 1

你shouldn't Select and Activate ranges

移动列的过程可以像这样

Option Explicit

Public Sub MoveColumns1()
   Const SDEL = "|||"    'column names cannot contain the delim chars ("|||")
   Const CN = "Col2" & SDEL & "Col1 `!@#$%^&*()_+-={}[];':"""",./<>?"

   Dim ws As Worksheet, cols As Variant, arr As Variant, newStart As Long, cnX As String
   Dim trim1 As String, trim2 As String, i As Long, j As Long, cn1 As String

   Set ws = Sheet1          'Or: Set ws = ThisWorkbook.Worksheets("Sheet1")
   cn1 = "Col3 - Line 1" & Chr(10) & "Col3 - Line 2" & Chr(10) & "Col3 - Line 3"
   cnX = cn1 & SDEL & CN    'Header with multiple lines of text, separated by Chr(10)
   cols = Split(cnX, SDEL)  '0-based array containing names defined in cnX
   arr = ws.Range(ws.Cells(1), ws.Cells(1, ws.Columns.Count).End(xlToLeft)) 'hdr row (1)

   Application.ScreenUpdating = False   'Turn screen Off
   For i = 1 To UBound(arr, 2)          'Iterate all Header cells (in row 1)
      trim1 = Trim$(arr(1, i))          'Trim left/right white-spaces from each Header
      For j = 0 To UBound(cols)         'Iterate each name defined in cnX
         trim2 = Trim$(cols(j))         'Trim left/right white spaces in current cnX
         If Len(trim1) >= Len(trim2) Then       'If Header is longer than current cnX
            If InStrB(1, trim1, trim2) > 0 Then 'If Header contains current cnX
               ws.Cells(i).EntireColumn.Cut         'Copy current cnX column (i)
               ws.Cells(1).Insert Shift:=xlToRight  'Paste column as first (1)

               newStart = Len(cnX) - (InStr(1, cnX, trim2) + Len(trim2) + Len(SDEL) - 1)
               If newStart < 1 Then Exit Sub    'If the cnX list is empty, we are done
               cols = Split(Right(cnX, newStart), SDEL)  'Remove current cnX
               Exit For                         'Done with current cnX
            End If
         End If
      Next
   Next
   Application.ScreenUpdating = False   'Turn screen back On
End Sub

修改顶部的常量CN以包含要移动的所有列

在

注意：如果列名包含多行文本，则只能将第一行添加到常量CN。您还可以使用多行文本定义每个单独的列名称，因为我在变量cn1

中定义了它

这也有效：

Public Sub MoveColumns2()
   Const SDEL = "|||"    'column names cannot contain the delim chars ("|||")
   Const CN = "Col3 - Line 1" & SDEL & "Col2" & SDEL & "Col1 `!@#$%^&*()_+-={}[];':"""",./<>?"

   Dim ws As Worksheet, cols As Variant, arr As Variant, newStart As Long, cnX As String
   Dim trim1 As String, trim2 As String, i As Long, j As Long, cn1 As String

   Set ws = Sheet1          'Or: Set ws = ThisWorkbook.Worksheets("Sheet1")
   cnX = CN                 'Header with multiple lines of text, separated by Chr(10)
   cols = Split(cnX, SDEL)  '0-based array containing names defined in cnX
   arr = ws.Range(ws.Cells(1), ws.Cells(1, ws.Columns.Count).End(xlToLeft)) 'hdr row (1)

   Application.ScreenUpdating = False   'Turn screen Off
   For i = 1 To UBound(arr, 2)          'Iterate all Header cells (in row 1)
      trim1 = Trim$(arr(1, i))          'Trim left/right white-spaces from each Header
      For j = 0 To UBound(cols)         'Iterate each name defined in cnX
         trim2 = Trim$(cols(j))         'Trim left/right white spaces in current cnX
         If Len(trim1) >= Len(trim2) Then       'If Header is longer than current cnX
            If InStrB(1, trim1, trim2) > 0 Then 'If Header contains current cnX
               ws.Cells(i).EntireColumn.Cut         'Copy current cnX column (i)
               ws.Cells(1).Insert Shift:=xlToRight  'Paste column as first (1)

               newStart = Len(cnX) - (InStr(1, cnX, trim2) + Len(trim2) + Len(SDEL) - 1)
               If newStart < 1 Then Exit Sub    'If the cnX list is empty, we are done
               cols = Split(Right(cnX, newStart), SDEL)  'Remove current cnX
               Exit For                         'Done with current cnX
            End If
         End If
      Next
   Next
   Application.ScreenUpdating = False   'Turn screen back On
End Sub

Answer 2

根据您的说明，如果您更改Select的{{1}}和xlUp的{{1}}，则您传递的代码将有效。所以它看起来像

xlDown

但是，如果该列中有空行可能会产生一些问题（因为在您的描述中，您声明要选择整个列）。所以我会选择以下

Rows("1:1").Select

Selection.Find(What:="LongColumnName", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Select
Selection.End(xlDown).Select

VBA在Selection.Find之后按名称选择列

2 个答案: