如何创建具有动态范围

Question

我有数据，其中有很多列标题。其中一个标题是“Text”，另一个标题是“Value Date”。我希望将这些列之间的每一行中包含的值组合在另一列中。

问题是这两个标题之间的列数不是常数。它会随着我导出的每个新分类帐而变化。因此，我希望我的代码是动态的，它将识别“文本”列，然后它将标识“值日期”列，并将所有内容组合在另一列中。

这是我用我的代码达到的地方，但我不知道它为什么不起作用。过去3天我一直在尝试这个，但却无处可去。当我运行此代码时，我得到的结果是“TextColumnNo：ValueColumnNo”。

Sub TextJoin()

Dim TextColumnNo As Range
Dim ValueColumnNo As Range

Range("A1").Select
ActiveCell.EntireRow.Find("Text").Activate
Set TextColumnNo = Range(ActiveCell.Address(False, False))
Range("A1").Select
ActiveCell.EntireRow.Find("Value").Activate
Set ValueColumnNo = Range(ActiveCell.Address(False, False))
ActiveCell.Offset(1, -1).Select
Application.CutCopyMode = False
ActiveCell.Value = Application.WorksheetFunction.TextJoin(" ", True, _ 
"TextColumnNo:ValueColumnNo")
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A8524")
ActiveCell.Range("A1:A8524").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub

Answer 1

Sub TextJoin()


Dim ColRefText As Long
Dim ColRefValueDate As Long
Const firstcol = "Text"
Const secondcol = "Value Date"
Dim r As Range
Set r = Rows(1).Cells.Find(firstcol)
If Not r Is Nothing Then
  ColRefText = r.Column
    Set r = Rows(1).Cells.Find(secondcol)
    If Not r Is Nothing Then
         ColRefValueDate = r.Column
    End If
End If
If ColRefValueDate + ColRefText > 0 Then
With Cells(2, Worksheets(1).Columns.Count).End(xlToLeft).Offset(0, 1)
    .Formula = Replace("=" & Cells(2, ColRefText).AddressLocal & "&" & Cells(2, ColRefValueDate).AddressLocal, "$", "")
    .Copy Range(.Address, Cells(ActiveSheet.UsedRange.Rows.Count, .Column).Address)
End With
End If
End Sub

Answer 2

你需要2个循环。一个循环遍历所有行，一个循环遍历列以组合每行的文本。

请注意，您需要在此处调整工作表名称和输出列等内容。

Option Explicit

Public Sub TextJoin()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1") 'define a worksheet

    'find start
    Dim FindStart As Range
    Set FindStart = ws.Rows(1).Find("Text")
    If FindStart Is Nothing Then
        MsgBox "start not found"
        Exit Sub
    End If

    'find end
    Dim FindEnd As Range
    Set FindEnd = ws.Rows(1).Find("Value Date")
    If FindEnd Is Nothing Then
        MsgBox "start not found"
        Exit Sub
    End If

    'find last used row in column A
    Dim lRow As Long
    lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row


    Dim iRow As Long
    For iRow = 2 To lRow 'loop through all rows (2 to last used row)
        Dim CombinedText As String
        CombinedText = vbNullString 'initialize/reset variable

        Dim iCol As Long 'loop through columns for each row (from start to end column)
        For iCol = FindStart.Column To FindEnd.Column
            CombinedText = CombinedText & ":" & ws.Cells(iRow, iCol).Text 'combine values
        Next iCol

        ws.Range("Z" & iRow) = CombinedText 'write values in column Z
    Next iRow
End Sub