按列标题搜索和替换

Question

抱歉……我的 VBA 技能几乎不存在……

我要做的是在 Excel 中创建一个宏，其中列 (1) 中的数据被列标题（SAND、LS 和 CS）替换。这是一个示例表：

DEPTH	SAND	LS	CS
600	1	-999	-999
700	-999	-999	1
800	1	-999	-999
900	-999	1	-999

这是我运行宏时的结果：

DEPTH	SAND	LS	CS
600	SAND	-999	-999
700	-999	-999	CS
800	SAND	-999	-999
900	-999	LS	-999

但是，我需要让 Excel 读取第一行中的 Header 来替换 1。不是列字母（例如读取 SAND 而不是 Columns("B:B") 在下面的代码中。我有许多相同格式的不同文件，但列数和列标题不同，因此问题。

这是我创建的宏的示例。

Sub LithReplace()
'
' LithReplace Macro
'

'
    Range("B1").Select
    Selection.Copy
    Columns("B:B").Select
    Selection.Replace What:="1", Replacement:="SAND            ", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Range("C1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("C:C").Select
    Selection.Replace What:="1", Replacement:="LS              ", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Range("D1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("D:D").Select
    Selection.Replace What:="1", Replacement:="CS               ", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
End Sub

提前致谢。

Answer 1

试试：

Sub test()
Dim rng As Range
Dim MyColumn As Range
Set rng = Range("A1").CurrentRegion 'dataset. Replace A1 by top left cell reference

For Each MyColumn In rng.Columns
    If MyColumn.Column > 1 Then 'we skip first column
        MyColumn.Replace "1", MyColumn.Cells(1, 1).Value, xlPart 'replace 1 with 'top cell of each column
    End If
Next MyColumn

Set rng = Nothing
End Sub

代码将遍历每一列，并将任何1 替换为每一列的顶部单元格值，因此它适用于任何列数量

我在执行代码后得到这个：

重要提示：考虑使用xlWhole而不是xlPart，因为现在如果有任何1，它将被替换，所以像213这样的东西可以转换成@987654330 @。

Range.Replace method (Excel)

Answer 2

执行如下通用的操作：

1. 定义您的工作表
2. 找出有多少列
3. 定义需要进行替换的范围。在这里，我们希望从第 2 列转到最后一列，并保留第一列。
4. 循环列以将每列中的 1 替换为其标题。

举例

Option Explicit

Public Sub LithReplace()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1") 'specify your sheet name
    
    Dim LastUsedColumn As Long 'find the last used column in the header row
    LastUsedColumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    Dim RangeToReplace As Range 'range to replace is from column 2 to the last used column
    Set RangeToReplace = ws.Range(ws.Columns(2), ws.Columns(LastUsedColumn))
    
    Dim Column As Range
    For Each Column In RangeToReplace.Columns 'loop through all columns in that range
        'in each column replace "1" with the value in the header cell of that column Column.Cells(1, 1)
        Column.Replace What:="1", Replacement:=Column.Cells(1, 1), _
                       LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                       ReplaceFormat:=False
        
    Next Column
End Sub

请注意，您需要LookAt:=xlWhole，否则如果您LookAt:=xlPart 并且有一个数字包含 1，例如614，它将替换为6SAND4。

Answer 3

通过Evaluate()替代

基本上是一个班轮：rng.Value = Evaluate(myFormula)

Sub ReplaceNumberOne()
    'a) define data range
    With Sheet1                  ' << change to wanted project's sheet Code(Name)
        Dim LastRow As Long, LastCol As Long
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    
        Dim rng As Range
        Set rng = .Range("A1", .Columns(LastCol)).Resize(LastRow)
        
    End With
    'b) define range addresses (strings)
    Dim dataAddr As String, headAddr As String
    dataAddr = rng.Address: headAddr = rng.Resize(1, LastRow).Address
    'c) define formula to be evaluated
    Dim myFormula As String          ' e.g. "=if(A1:D5=1,A1:D1,A1:D5&"""")"
    myFormula = Replace(Replace("=if(x=1,y,x&"""")", "x", dataAddr), "y", headAddr)
    Debug.Print myFormula
    '~~~~~~~~~~~~~~~~~~~~~~~~
    'd) replace by one code line
    '~~~~~~~~~~~~~~~~~~~~~~~~
    rng.Value = Evaluate(myFormula)
End Sub