如何遍历行和列并在Excel VBA中连接两个文本单元格?

时间:2013-07-09 16:39:26

标签: excel vba

我是Excel Macros的新手,我正在寻找一种循环行标题和列标题的方法,并将它们组合成每个行和列标题的一个单元格,直到我将所有这些组合在一起。

第一列单元格的示例是“您的组织标题”

第一行细胞的例子是“22. Cheif投资官”

我想要在新表上的第一个组合单元格的例子如下:“22。首席投资官(贵组织的标题)

然后,我希望新工作表上的组合单元格向右偏移一列,直到它遍历所有行和列。

我刚加入论坛,它不会让我发布图片或我会发布。也许这会给出一个更好的主意,现在这是我的代码:

Sub Fill()

' Select cell A2, *first line of data*.
Set title = Sheets("Compensation, 3").Range("B6:B500")
Set descr = Sheets("Compensation, 3").Range("C5:AAA5")
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(title.Value)
  Do Until IsEmpty(descr.Value)
    ActiveCell.Offset(0, 1).Formula = _
      "=title.value & "" ("" & descr.value & "")"""
    Set descr = descr.Offset(0, 1)
  Loop
  Set title = title.Offset(1, 0)
Loop

End Sub

当我运行时,将其放入活动单元格中:
=title.value & " (" & descr.value & ")"
它无法识别变量并提出NAME错误。它也进入无限循环,除了一个单元格之外没有输出。

编辑: 我不能回答我自己的问题,因为我是论坛的新手,但结合你的答案,我已经解决了问题! 这是完成的代码:

Sub Fill()
  ' Select cell A2, *first line of data*.
  Set title = Sheets("Compensation, 3").Range("B6")
  Set descr = Sheets("Compensation, 3").Range("C5")
  offsetCtr = 0
  ' Set Do loop to stop when an empty cell is reached.
  Do Until IsEmpty(title.Value)
      Do Until IsEmpty(descr.Value)
         ActiveCell.Offset(0, offsetCtr).Formula = title.Value & " (" & descr.Value & ")"
         offsetCtr = offsetCtr + 1 
         Set descr = descr.Offset(0, 1)
     Loop
     Set descr = Sheets("Compensation, 3").Range("C5")
     Set title = title.Offset(1, 0)
  Loop

End Sub

非常感谢你!

2 个答案:

答案 0 :(得分:1)

Option Explicit
Sub GenerateAndPasteFormulaForTitleAndDescription( _
ByVal titlesRange As Range, ByVal descriptionRange As Range, _
ByVal startCellOnDestination As Range)
Dim title As Range
Dim descr As Range

Dim offsetCtr As Long

Dim formulaTemplate As String
Dim newFormula As String

formulaTemplate = "=CONCATENATE([1], '(', [2], ')')"


startCellOnDestination.Worksheet.EnableCalculation = False

For Each title In titlesRange.Cells
    For Each descr In descriptionRange.Cells
        If title.Value <> "" And descr.Value <> "" Then
            newFormula = Replace(formulaTemplate, "[1]", _
                title.Address(External:=True))
            newFormula = Replace(newFormula, "[2]", _
                descr.Address(External:=True))
            newFormula = Replace(newFormula, "'", Chr(34))

            startCellOnDestination.Offset(0, offsetCtr).Formula = newFormula
            offsetCtr = offsetCtr + 1
        End If
    Next
Next

startCellOnDestination.Worksheet.EnableCalculation = True
End Sub

以下是如何调用上述程序

GenerateAndPasteFormulaForTitleAndDescription _
   Sheets("Compensation, 3").Range("B6:B500"), _
   Sheets("Compensation, 3").Range("C5:AAA5"), _
   Sheets("new sheet").Range("B5")

编辑:代码循环通过标题和描述的组合,检查它们是否都不为空并创建公式。它将公式粘贴到起始单元格(在本例中为Sheets("new sheet").Range("B5"))并向前移动并将下一个公式粘贴到其旁边的列中

答案 1 :(得分:0)

基本上,您正在尝试在工作表函数中使用VBA对象。它并不是那么有效。

尝试替换

"=title.value & "" ("" & descr.value & "")"""

=title.value & " (" & descr.value & ")"