1

私はExcelマクロにかなり慣れていないので、行見出しと列見出しをループして、それらをすべて組み合わせるまで、行見出しと列見出しごとに1つのセルに結合する方法を探しています。

最初の列のセルの例は、「あなたの組織のタイトル」です。

最初の行のセルの例は、「22. 最高投資責任者」です。

新しいシートに必要な最初の結合セルの例は次のようになります: "22. 最高投資責任者 (あなたの組織の役職)

次に、すべての行と列を反復処理するまで、新しいシートの結合されたセルを 1 列右にオフセットします。

フォーラムに参加したばかりですが、画像を投稿できません。おそらく、これはより良いアイデアを与えるでしょう、ここに私のコードがあります：

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 エラーが発生します。また、1 つのセル以外に何も出力されない無限ループに入ります。

編集:私はフォーラムに不慣れなため、自分の質問に答えることができませんが、あなたの回答を組み合わせて問題を解決しました! 完成したコードは次のとおりです。

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

どうもありがとう！

4

2 に答える 2

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")この場合) に貼り付け、先に移動して次の数式をその隣の列に貼り付けます。

于 2013-07-09T19:55:26.013 に答える
0

基本的に、ワークシート関数で VBA オブジェクトを使用しようとしています。そのようにはうまくいきません。

交換してみる

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

と

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

于 2013-07-09T19:36:51.270 に答える