私は最初の VBA の本を読んでいます。誰かが私を正しい方向に向けてくれれば幸いです。改行を使用して行の範囲を単一のセルに転送するにはどうすればよいですか? 次に、列のすべての範囲に対してこのアクションを繰り返したいと思います。
私はする必要があると思います:
- 列の値を持つ最初のセルを見つける
- 次の行が空でないことを確認します
- 範囲内の最後のセルを見つける
- 範囲で「操作」を実行します
私のコメントをフォローアップします。これは、あなたが望むものを達成するための非常に簡単な方法です。
Option Explicit
'~~> You can use any delimiter that you want
Const Delim = vbNewLine
Sub Sample()
Dim rngInput As Range, rngOutput As Range
Application.ScreenUpdating = False
Set rngInput = Range("A1:A5") '<~~ Input Range
Set rngOutput = Range("B1") '<~~ Output Range
Concatenate rngInput, rngOutput
Application.ScreenUpdating = True
End Sub
Sub Concatenate(rng1 As Range, rng2 As Range)
Dim cl As Range
Dim strOutPut As String
For Each cl In rng1
If strOutPut = "" Then
strOutPut = cl.Value
Else
strOutPut = strOutPut & Delim & cl.Value
End If
Next
rng2.Value = strOutPut
End Sub
ワークシート レベルのコードのコンテキスト内では、次のように動作します。列 2 はハードコーディングされているため、値を渡すか、必要に応じて変更する必要がある場合があります。
Dim rng As Range
Set rng = Me.Columns(2)
Dim row As Integer
row = 1
' Find first row with non-empty cell; bail out if first 100 rows empty
If IsEmpty(Me.Cells(1, 2)) Then
Do
row = row + 1
Loop Until IsEmpty(Me.Cells(row, 2)) = False Or row = 101
End If
If row = 101 Then Exit Sub
' We'll need to know the top row of the range later, so hold the value
Dim firstRow As Integer
firstRow = row
' Combine the text from each subsequent row until an empty cell is encountered
Dim result As String
Do
If result <> "" Then result = result & vbNewLine
result = result & Me.Cells(row, 2).Text
row = row + 1
Loop Until IsEmpty(Me.Cells(row, 2))
' Clear the content of the range
Set rng = Me.Range(Me.Cells(firstRow, 2), Me.Cells(row, 2))
rng.Clear
' Set the text in the first cell
Me.Cells(firstRow, 2).Value2 = result