Question

查看合并工作表的手动映射解决方案，以及搜索映射头解决方案。基础是这个

Dest_Worksheet：这有合并后需要的唯一标题（最多50列）
Source_Worksheet1：这有一个项目列表，其中一些标题与Dest_Worksheet匹配（最多100列 - 与Source_Worksheet2不同）
Source_Worksheet2：这有一个项目列表，其中一些标题与Dest_Worksheet匹配（最多100列 - 与Source_Worksheet1不同）

运行时未知的总行数。目前建立了手动映射（见下文）。

ASKING ：超越每个工作表的手动映射到审查Dest_Worksheet并引用这些标题的解决方案，在剩余或已识别的Source工作表列表中移动并复制仅包含与Dest_Worksheet匹配的列的所有行

See sample worksheet for working manual mapping code below

'******Manual Mapping of Source_Data1*******
Sub Source_Data1()
Dim sht As Worksheet
Dim colname As String
Dim Lastrow As Integer, rowcount As Integer
colname = 1

For Each sht In ActiveWorkbook.Worksheets
    If sht.Name = "Source_Worksheet1" And sht.Range("A3").Value <> "" Then
        Sheets("Source_Worksheet1").Select
        Lastrow = Range("A9000").End(xlUp).Row
        Sheets("Dest_Worksheet").Select
        rowcount = Range("A9000").End(xlUp).Row + 1
        sht.Select

        Sheets("Dest_Worksheet").Range("A" & rowcount & ":A" & rowcount + Lastrow - 3).Value = sht.Range("A3:A" & Lastrow).Value
        Sheets("Dest_Worksheet").Range("B" & rowcount & ":B" & rowcount + Lastrow - 3).Value = sht.Range("B3:B" & Lastrow).Value
        Sheets("Dest_Worksheet").Range("C" & rowcount & ":C" & rowcount + Lastrow - 3).Value = sht.Range("C3:C" & Lastrow).Value
        Sheets("Dest_Worksheet").Range("D" & rowcount & ":D" & rowcount + Lastrow - 3).Value = sht.Range("D3:D" & Lastrow).Value

    End If
Next sht

Worksheets("Dest_Worksheet").Select

End Sub

'******Manual Mapping of Source_Data2*******
Sub Source_Data2()
Dim sht As Worksheet
Dim colname As String
Dim Lastrow As Integer, rowcount As Integer
colname = 1

For Each sht In ActiveWorkbook.Worksheets
    If sht.Name = "Source_Worksheet2" And sht.Range("A3").Value <> "" Then
        Sheets("Source_Worksheet2").Select
        Lastrow = Range("A9000").End(xlUp).Row
        Sheets("Dest_Worksheet").Select
        rowcount = Range("A9000").End(xlUp).Row + 1
        sht.Select

        Sheets("Dest_Worksheet").Range("A" & rowcount & ":A" & rowcount + Lastrow - 3).Value = sht.Range("A3:A" & Lastrow).Value
        Sheets("Dest_Worksheet").Range("E" & rowcount & ":E" & rowcount + Lastrow - 3).Value = sht.Range("B3:B" & Lastrow).Value
        Sheets("Dest_Worksheet").Range("F" & rowcount & ":F" & rowcount + Lastrow - 3).Value = sht.Range("C3:C" & Lastrow).Value
        Sheets("Dest_Worksheet").Range("C" & rowcount & ":C" & rowcount + Lastrow - 3).Value = sht.Range("E3:E" & Lastrow).Value

    End If
Next sht

Worksheets("Dest_Worksheet").Select

End Sub

Answer 1

经过大量的反复试验后，我Find()正在努力返回我要找的专栏信。这是我最终使用的代码和相关的函数调用：

Sub LookupText()
Dim DestLetter As String

DestLetter = TextLookup("Search Text")
MsgBox DestLetter

End Sub


'***********
Function TextLookup(TheText As String) As String

Set Cell = Worksheets("Destination_Worksheet").Cells.range("A1:DA1").Find(TheText, , xlValues, xlPart, , , False)

If Not Cell Is Nothing Then
    ColLetter = Split(Cell.Address, "$")(1)
    TextLookup = ColLetter
End If

End Function

Excel VBA：通过搜索/映射标头合并工作表？

1 个答案: