按列名循环遍历列

Question

我想将列中的每个字符串设为小写并删除所有空格。但我想引用代码中的列名而不是列号（因为它可能会有所不同，我想在其他 sheets 上使用代码，其中列具有相同的名称，但不在一样的地方）。 sheet 中的数据如下（简单示例）：

furniture	color	amount
chair	Pink	2
sofa	pin k	1
table	bLue	1
sofa		1

所以第 1 行实际上是 header。我想将 'color'

列中的值小写并删除空格

我试过了

For Each cell In Column('color').cells

        cell.Value = LCase(cell.Value)

    Next cell

似乎连循环都做不好

有人有什么建议吗？提前致谢

Answer 1

只是一些快速代码，但我认为它应该可以工作。 GetColumnNumber 函数采用名称和范围并在范围的第一行中查找具有该名称的列。它 returns 它找到它的列号。其他代码只是循环遍历所有行，进行所描述的替换和小写。

Sub test()
   Dim myrange As Range
   
   Set myrange = Application.ActiveSheet.usedrange
   
   colorcolumn = GetColumnNumber("color", myrange)
   For x = 2 To myrange.Rows.Count
      currdata = myrange.Cells(x, colorcolumn)
      myrange.Cells(x, colorcolumn) = Replace(LCase(currdata), " ", "")
    Next x
   
End Sub

Function GetColumnNumber(n As String, r As Range)
    For x = 1 To r.Columns.Count
        If r.Cells(1, x) = n Then
            GetColumnNumber = x
            Exit For
        End If
    Next x
End Function

Answer 2

请尝试下一种方式：

Sub LowerCaseNoSpaces()
  Dim sh As Worksheet, lastR As Long, colName As String, rngProc As Range, necCol As Range
  
  colName = "color"
  Set sh = ActiveSheet

  Set necCol = sh.rows(1).Find(what:=colName, LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False)
  If Not necCol Is Nothing Then 'if the header has been found:
        Set rngProc = sh.Range(necCol, sh.cells(sh.rows.count, necCol.Column).End(xlUp)) 'set the range from the header to the last filled cell in that column
        'process all the filled column using Evaluate:
        rngProc.value = Application.Evaluate("SUBSTITUTE(LOWER(" & rngProc.Address & "), "" "", """")")
  End If
End Sub

Answer 3

假设您要替换所有空格而不仅仅是 trim 字符串，这应该与@BigBen 的建议 Range.Find 和循环单元格

一起使用

Option Explicit

Public Sub ChangeColumToLower()

    Const HEADER_ROW    As Integer = 1
    Const FIND_COLUMN   As String = "color"
    
    Dim rgeHeader   As Range
    Dim rgeColumn   As Range
    Dim rgeValues   As Range
    
    Dim lngCol      As Long
    Dim lngRow      As Long
    Dim lngLastRow  As Long
    
    Dim colValue    As Object
    
    Set rgeHeader = Range(HEADER_ROW & ":" & HEADER_ROW) ' Header Row
    Set rgeColumn = rgeHeader.Find(FIND_COLUMN)
    lngCol = rgeColumn.Column
    lngRow = rgeColumn.Row + 1
    
    ' Best way to find last row of data if column has empty cells
    lngLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row 
    
    Set rgeValues = Range(Cells(lngRow, lngCol), Cells(lngLastRow, lngCol))
    
    ' Loop through all values
    For Each colValue In rgeValues
        ' Change to lower case and remove all spaces
        colValue.Value = Replace(LCase(colValue.Value), " ", vbNullString)
    Next
        
End Sub

Answer 4

降低并替换列范围

Option Explicit

Sub LowerAndReplaceInColumnRangeTEST()
    
    Const Header As String = "Color"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
    
    LowerAndReplaceInColumnRange ws, Header ' , 1, " ", "" ' default values

End Sub

Sub LowerAndReplaceInColumnRange( _
        ByVal ws As Worksheet, _
        ByVal Header As String, _
        Optional ByVal HeaderRow As Long = 1, _
        Optional ByVal SearchString As String = " ", _
        Optional ByVal ReplaceString As String = "")
    Const ProcName As String = "LowerAndReplaceInColumnRange"
    On Error GoTo ClearError
    
    Dim hCol As Variant: hCol = Application.Match(Header, ws.Rows(HeaderRow), 0)
    If IsError(hCol) Then Exit Sub ' header not found
    
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, hCol).End(xlUp).Row
    If lRow <= HeaderRow Then Exit Sub ' no data or just header
    
    Dim rCount As Long: rCount = lRow - HeaderRow
    Dim rg As Range: Set rg = ws.Cells(HeaderRow + 1, hCol).Resize(rCount)
    
    rg.Value = ws.Evaluate("=SUBSTITUTE(LOWER(" & rg.Address _
        & "),""" & SearchString & """,""" & ReplaceString & """)")
    
ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Sub

按列名循环遍历列

Loop through column by column name

excel

vba

降低并替换列范围