よろしくお願いします。
Excel2007です。
A1からA5000までデータが入っています。
データは文字列です。
その文字列を上から順に比較していき、
隣接する上下のデータが一致した場合、
さらにその下が一致しているかを調べ、
その作業を一致しなくなるまで続けます。
最後に、一致した部分すべてを選択し、
セルをまとめて結合し、左寄せしたいのです。
まとめて結合し、左寄せ、という部分は、
マクロを記録し、以下のようにするのはわかったのですが、
Range("a4123:a4131").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
そして、これをa5000(データが格納されている最後のセル)まで
続けたいのです。
例えば、
A1とA2を比較し、一致しないなら、A2とA3を比較。
一致したら、さらにA2とA4が一緒かどうか比較。
一致が無くなるまで続けて、最後に処理。
という感じです。
前半の部分が全くわかりません。
ご教示願えませんでしょうか。よろしくお願いします。
No.1ベストアンサー
- 回答日時:
こんな感じ? (とりあえず100行に設定してあります)
結合後のセルの設定は、左寄せと、縦の中央表示しかしていませんので、必要なら付け加えてください。
また、空白セルが連続していても結合されます。(同じ内容の連続だから)
空白セルは例外とする場合は、セルの値が空白だったら次のセルに行くようにすれば良いです。
Sub test()
Dim rw As Long, tmp As Long
Dim str As String, flg As Boolean
Const rwEnd = 100 '//最終行
rw = 1
While (rw < rwEnd)
str = Cells(rw, 1).Text '//対象セルの値(文字列)
flg = False
For tmp = rw + 1 To rwEnd
If Cells(tmp, 1).Text = str Then flg = True Else Exit For
Next tmp
If flg Then
Application.DisplayAlerts = False '//結合時の警告表示をキャンセル
Range(Cells(rw, 1), Cells(tmp - 1, 1)).Merge
Application.DisplayAlerts = True
Cells(rw, 1).HorizontalAlignment = xlLeft '//書式設定(左寄せ)
Cells(rw, 1).VerticalAlignment = xlCenter
rw = tmp '//次の行までスキップ
Else
rw = rw + 1
End If
Wend
End Sub
No.5
- 回答日時:
いろんなやり方がありますね。
参考までに
Sub test01()
Dim MyUn As Range
Dim i As Long
For i = 2 To 5000
If Cells(i, "A") <> "" And Cells(i, "A") = Cells(i - 1, "A") Then
If MyUn Is Nothing Then
Set MyUn = Union(Cells(i, "A"), Cells(i - 1, "A"))
Else
Set MyUn = Union(MyUn, Cells(i, "A"))
End If
Else
If Not MyUn Is Nothing Then
With MyUn
Application.DisplayAlerts = False
.MergeCells = True
Application.DisplayAlerts = True
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
Set MyUn = Nothing
End If
End If
Next i
End Sub
A5000までの途中で空白があってもかまいません。空白セル同士は結合させません。
No.4
- 回答日時:
Sub test()
Application.DisplayAlerts = False
Range("A1").Activate
While ActiveCell <> ""
i = 1
While ActiveCell = ActiveCell.Offset(i)
i = i + 1
Wend
With ActiveCell
.HorizontalAlignment = xlLeft
.Resize(i).MergeCells = True
End With
ActiveCell.Offset(1).Activate
Wend
Application.DisplayAlerts = True
End Sub
こんな感じ
No.3
- 回答日時:
一例です
Sub test()
Dim i As Long, ii As Long
i = 1
ii = 1
Application.DisplayAlerts = False
Do Until Cells(i, 1).Value = ""
ii = ii + 1
If Not Cells(i, 1).Value = Cells(ii, 1).Value Then
Range(Cells(i, 1), Cells(ii - 1, 1)).MergeCells = True
i = ii
End If
Loop
Application.DisplayAlerts = True
End Sub
A列、連続でデータがあること
空白がある場合、そこで終わり
No.2
- 回答日時:
説明のとおり作成すれば以下のようになります。
---
Sub mCheck()
i = 1 '開始
Do Until Trim$(Cells(i, 1).Value) = "" '最後のセルまで
j = i + 1
Do Until Cells(i, 1).Value <> Cells(j, 1).Value '一致しなくなるまで比較
j = j + 1
Loop
If j > i + 1 Then '一致した場合
Call 結合処理
End If
i = j
Loop
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) マクロで最終行を取得してコピーしたい 3 2022/04/06 19:07
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Excel(エクセル) エクセルのマクロでコピー後の貼り付け先を毎回指定したところにしたい 5 2022/08/12 10:47
- Visual Basic(VBA) 最終列の右へSUM関数を作成するため下記コードを実行しましたが、最終列「10月28日」が上書きされて 3 2022/12/05 20:32
- Visual Basic(VBA) データのある範囲を選択するVBAについて 2 2022/09/03 00:20
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Visual Basic(VBA) まとめシートから集計シートへA列のコードが一致したら1行コピーするマクロをネット上で見つけました。こ 1 2022/08/30 14:11
- Excel(エクセル) EXCEL関数(数式)を教えてください 2 2022/06/08 18:32
- Excel(エクセル) エクセルで2つの表を比較して、文字列が同じだが、その行のある値が違うものを抽出したい 1 2022/10/06 21:48
- Excel(エクセル) Excel2019 マクロを使用し画像を貼り付けした際のリンク切れについて 2 2022/11/15 16:14
このQ&Aを見た人はこんなQ&Aも見ています
-
「どうして捨てられないの?」前妻の物を捨てられない男性の心理って?
前妻の物を捨てられない理由に加え、捨てるための手段はあるのかを専門家に聞いてみた!
-
エクセル マクロで数値が変った時行挿入できますか
Excel(エクセル)
-
VBA Cのセルが空白でなかったら、Aのセルに順番に数値を入力
Visual Basic(VBA)
-
マクロ(Excel)で上下のセルの値が同じ場合、特定の列のセルを統合する方法
Excel(エクセル)
-
-
4
数式による空白を無視して最終行を取得するマクロ
Excel(エクセル)
-
5
エクセルVBAでセルに入力したパスでブックを開く
Excel(エクセル)
-
6
VBAで保存しないで閉じると空のBookが残る
Excel(エクセル)
-
7
別のシートから値を取得するとき
Visual Basic(VBA)
-
8
エクセル:マクロ「Application.CutCopyMode = False」って?
Excel(エクセル)
-
9
保存先のフォルダ名を指定したいとき
Visual Basic(VBA)
-
10
VBA データ(特定値)のある最終行を取得したい
Excel(エクセル)
-
11
Excel VBAで比較して数値があってなかったらセルの色を変換
Visual Basic(VBA)
-
12
VBA 空白セルを削除ではない方法で詰めるやり方
Visual Basic(VBA)
-
13
一行おきに貼り付ける 可能でしょうか
Visual Basic(VBA)
-
14
【Excel VBA】複数ある特定の文字列を含む行を削除
Excel(エクセル)
-
15
オートフィルターをかけ、#N/A以外で絞込みするVBA記述をご教示ください
Excel(エクセル)
-
16
特定の文字を含むシートだけマクロ処理をしたい
Visual Basic(VBA)
-
17
別ファイルを開かず、INDIRECT関数を使用せずに、別ファイルのデータを求めたい
Excel(エクセル)
-
18
worksheetFunctionクラスのVlookupプロパティを取得できません エラーへの対応
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
IF関数で空欄("")の時、Null...
-
数式による空白を無視して最終...
-
「データ要素を線で結ぶ」がチ...
-
ピボットテーブルで空白セルの...
-
Excel > ピボットテーブル「(空...
-
《Excel2000》SUMPRODUCT関数で...
-
エクセルでCSVを編集するとき、...
-
Excel:関数が入っているセルに...
-
エクセル 連番が途切れていると...
-
関数TRANSPOSEで空白セルを0に...
-
Excelで、入力文字の後に自動で...
-
エクセルで上の行の値を自動的...
-
形式貼り付けの「空白を無視す...
-
空白を0とみなす関数
-
Excelで"0"を空白に変換する方法
-
excel2010 空白セルにのみ貼り...
-
SUMIFS関数で「計算式による空...
-
エクセルで、「複数のセルの中...
-
【Excel】 csvの作成時、空白セ...
-
初歩的なExcelの質問となります
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
IF関数で空欄("")の時、Null...
-
数式による空白を無視して最終...
-
エクセルでCSVを編集するとき、...
-
ピボットテーブルで空白セルの...
-
Excel > ピボットテーブル「(空...
-
関数TRANSPOSEで空白セルを0に...
-
excel2010 空白セルにのみ貼り...
-
「データ要素を線で結ぶ」がチ...
-
Excel:関数が入っているセルに...
-
Excelで、入力文字の後に自動で...
-
空白セル内の数式を残したまま...
-
色つき行の一括削除は?
-
エクセルで、「複数のセルの中...
-
エクセル 連番が途切れていると...
-
エクセルで上の行の値を自動的...
-
SUMIFS関数で「計算式による空...
-
【Excel】 csvの作成時、空白セ...
-
《Excel2000》SUMPRODUCT関数で...
-
エクセル セルのコピー元が空...
-
空白を0とみなす関数
おすすめ情報