マクロを固定して連続値を結合する

Question

今月から四半期に基づいてカレンダーを作成しています。私は最終ステップを踏んでいます。最後に、重複する値とセルを結合する方法と、カレンダーを流動して流れるようにそれらをマージします。

私が欲しいもの：

私はので、私は周りを探してきたし、一緒にこのコードを置くが、私は」初心者VBAコーダだが、C＃のといくつかの経験を持っている私が今持っている何

論理が正しいかどうか、それとも正しく動作するかわからない場合：

Option Explicit 

Public Sub MergeContiguousValues(col As Long) 

    Dim start As Range 
    Dim finish As Range 


    Set start = Cells(1, col) 
    Set finish = start 

    Application.DisplayAlerts = False 

    Do While start <> "" 

     Do While start = finish.Offset(1, 0) 
     Set finish = finish.Offset(1, 0) 
     Loop 

     If start.Address <> finish.Address Then 
     Range(start, finish).Merge 
     Range(start, finish).VerticalAlignment = xlCenter 
     End If 

     Set start = finish.Offset(1, 0) 
     Set finish = start 

    Loop 

    Application.DisplayAlerts = True 

End Sub 

どのようにすればいいですか？どこが間違っているの？

私はエントリーフォームからデータを運ぶ別々のシートから情報を引き出すための式を=IF(ISNUMBER(FINDという式で使用しています。

Answer 1

次のように私はRangeオブジェクトのAreasプロパティを使用したい：

Public Sub MergeContiguousValues(calendarColumns As Range, calendarStartRow As Long) 
    Dim i As Long 
    Dim area As Range 

    Application.DisplayAlerts = False 
    With calendarColumns 
     For i = calendarStartRow To LastRow(calendarColumns, calendarStartRow) 
      If WorksheetFunction.CountA(.Rows(i)) > 0 Then 
       For Each area In .Rows(i).SpecialCells(xlCellTypeFormulas).Areas 
        With area 
         .Merge 
         .VerticalAlignment = xlCenter 
        End With 
       Next area 
      End If 
     Next i 
    End With 
    Application.DisplayAlerts = True 
End Sub 

、ここLastRow()機能は以下：可能な利用が可能性があなたの例に従って

Function LastRow(rng As Range, minRow As Long) As Long 
    With rng.Parent 
     With Intersect(.UsedRange, rng.columns).SpecialCells(xlCellTypeFormulas) 
      LastRow = .Areas(.Areas.Count).Row 
     End With 
    End With 
    If LastRow < minRow Then LastRow = minRow 
End Function 

を：

Sub main() 
    MergeContiguousValues Worksheets("calendar").Range("D:O"), 4 
End Sub 

私はカレンダー付きのワークシートの名前として「カレンダー」を想定していました。あなたのニーズに合わせて変更してください

Answer 2

私はこれがあなたが探しているものだと思います。私は空白のワークシートでA1からD1までのセルA1と同じ値でテストしましたが、これが役に立ちますように！

Option Explicit 

Public Sub MergeContiguousValues() 

Dim start As Range 
Dim finish As Range 
Dim sVal As String 
Dim fVal As String 

'replace Cells(1, 1) with your passed variables 
Set start = Cells(1, 1) 
Set finish = start 

'set values for the starting and finishing cell 
sVal = start.Value 
fVal = finish.Value 

'check each column until the name is no longer the same 
Do While sVal = fVal 

    Set finish = finish.Offset(0, 1) 
    fVal = finish.Value 

Loop 

'backup one column 
Set finish = finish.Offset(0, -1) 

'clear all values and only place value in start range 
Range(start, finish).Value = "" 
Range(start.Address).Value = sVal 

'instead of merging, how about aligning across the start and finish range 
Range(start, finish).HorizontalAlignment = xlCenterAcrossSelection 

End Sub