A 回答 (4件)
- 最新から表示
- 回答順に表示
No.4
- 回答日時:
自分でも使いたい場面がありましたので、作成してみました。
誤動作するかもしれないので、必ずバックアップを取ってから試してみてください。当方XL2000です。作業シートを作成して、そちらに並べ替えてコピーし、元の範囲に書き戻します。'選択範囲の1列目(文字列、結合セル対応)をキーに並べ替え
Sub test()
Dim targetRange As Range
If TypeName(Selection) <> "Range" Then Exit Sub
Set targetRange = Selection
Call sortMergeCells(targetRange)
End Sub
Private Sub sortMergeCells(targetRange As Range)
Dim data() As Variant, dataRange() As Range
Dim myCell As Range
Dim i As Long
Dim newSheet As Worksheet
Const sortDirection As Long = 1 '昇順
Application.ScreenUpdating = False
Set myCell = targetRange.Cells(1)
i = 1
Do
ReDim Preserve data(1 To i), dataRange(1 To i)
data(i) = myCell.Value
Set dataRange(i) = myCell.MergeArea.Resize(, targetRange.Columns.Count)
Set myCell = myCell.Offset(1, 0)
i = i + 1
Loop Until Intersect(myCell, targetRange) Is Nothing
Call BubbleSortStrings(data, dataRange, sortDirection)
Set newSheet = Sheets.Add
Set myCell = newSheet.Range("a1")
For i = 1 To UBound(data)
dataRange(i).Copy myCell
Set myCell = myCell.Offset(1, 0)
Next i
newSheet.UsedRange.Copy targetRange.Cells(1)
Application.DisplayAlerts = False
newSheet.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
'Microsoftのバブルソートを改造
'direction 1:昇順、-1 降順
Private Sub BubbleSortStrings(sArray() As Variant, rArray() As Range, direction As Long)
Dim lLoop1 As Long
Dim lLoop2 As Long
Dim lTemp As String
Dim rTemp As Range
For lLoop1 = UBound(sArray) To LBound(sArray) Step -1
For lLoop2 = LBound(sArray) + 1 To lLoop1
If StrComp(sArray(lLoop2 - 1), sArray(lLoop2)) = direction Then
lTemp = sArray(lLoop2 - 1)
Set rTemp = rArray(lLoop2 - 1)
sArray(lLoop2 - 1) = sArray(lLoop2)
Set rArray(lLoop2 - 1) = rArray(lLoop2)
sArray(lLoop2) = lTemp
Set rArray(lLoop2) = rTemp
End If
Next lLoop2
Next lLoop1
End Sub
No.3
- 回答日時:
一応、例1をコーディングしてみました。
。セル結合が3セル限定だし、結合セルが横にも続いていると
意図したとおりに動かないと思われますが、質問の例なら動くんじゃないかと思います。
もっと汎用性を持たせたかったらセルのサーチの際にMergeAreaを考慮して作る必要があると思います。
Sub temp()
Call MGCellSortTest("M4:M242") 'ソートしたい範囲
End Sub
'結合セルのソート (縦限定)
Sub MGCellSortTest(RangeAdrs As String)
Dim RangeHdr As String 'ソートする箇所のヘッダ
Dim TempRange As Range
Dim TempRange2 As Range
RangeHdr = Range(RangeAdrs)(1).Address
'ソート範囲の結合セルを解除する
For Each TempRange In Range(RangeAdrs)
If TempRange.MergeCells = True Then
TempRange.MergeCells = False
End If
'空白だったら1セル上の値を入れておく
If TempRange.Row <> 1 And TempRange = "" Then
TempRange = TempRange.Offset(-1, 0)
End If
Next
'ソート 2007は未テスト
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Range(RangeHdr)
.SetRange Range(RangeAdrs)
.Apply
End With
'警告を消す
Application.DisplayAlerts = False
Dim i As Long
Dim col As Integer
col = Range(RangeAdrs).Column
'入力セルの先頭から最終行まで
With Range(RangeAdrs)
For i = .Row To .Rows(.Rows.Count).Row
'次のセルが同じ値だったら3セル分結合する
If Cells(i, col) = Cells(i + 1, col) Then
Range(Cells(i, col), Cells(i + 2, col)).Merge
i = i + 2
End If
Next
End With
Application.DisplayAlerts = True
End Sub
No.2
- 回答日時:
コードを書くのは面倒なのでどういう事をすればいいかを書きます。
例1の方が簡単かな。
例1:
1,まずソートしたい箇所のセル結合を解きます。
2,結合が解除された箇所は先頭を除いて空欄になるので、結合されていた箇所と同じ値を入れます。
3,ソートを実行します。
4,同じ値が入っているセルを3セルずつ?結合しなおします。
例2:
1,バブルソートでもクイックソートでもいいので自前でソート関数を実装します。
2,結合セルから値を取得して配列に格納します。
3,実装したソート関数で並べ替えます。
4,並べ替えた順に元のセルに値を入れます
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) ExcelVBAのマクロについて。 9 2022/05/04 14:50
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Excel(エクセル) 日付で矢印マクロ 4 2023/07/25 16:47
- Excel(エクセル) エクセル VBA For Next 繰り返しの書き方を教えてください 6 2022/09/01 14:11
- Visual Basic(VBA) EXCELのVBAについて 2 2023/07/05 17:17
- Visual Basic(VBA) 最終列の右へSUM関数を作成するため下記コードを実行しましたが、最終列「10月28日」が上書きされて 3 2022/12/05 20:32
- Visual Basic(VBA) Excelにて、シート1の行を削除するとシート2のシート1と同じ番号の行も削除したい 3 2022/05/08 04:24
- Visual Basic(VBA) エクセルVBA ダブルクリックしたら色反転を指定したセルのみにしたい 2 2022/04/06 12:52
- Excel(エクセル) EXCEL マクロで行を挿入して貼り付けようとするとエラーになる。 2 2022/05/24 09:43
- Visual Basic(VBA) 複数セルに〇印をつけるマクロ 4 2022/09/07 05:33
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelで数式内の文字色を一部だ...
-
セルをクリック⇒そのセルに入力...
-
エクセルで指定したセルのどれ...
-
【エクセル】IF関数 Aまたは...
-
エクセル 足して割る
-
貼り付けで複数セルに貼り付けたい
-
対象セル内(複数)が埋まった...
-
Excelでのコメント表示位置
-
エクセル “13ヶ月”を“1年1ヶ月...
-
エクセルのセルの枠を超えて文...
-
【Excel】 セルの色での判断は...
-
EXCELで、角度の「50.5度」を「...
-
excelのCOUNTIF関数で、『範囲=...
-
(Excel)数字記入セルの数値の後...
-
エクセル オートフィルタで絞...
-
Excel2003 の『コメント』の編...
-
エクセルの一つのセルに複数の...
-
EXCEL VBA セルに既に入...
-
Excelで住所を2つ(町名迄と番...
-
エクセルで第2、第4土曜日を抽...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで指定したセルのどれ...
-
【エクセル】IF関数 Aまたは...
-
貼り付けで複数セルに貼り付けたい
-
対象セル内(複数)が埋まった...
-
Excelで数式内の文字色を一部だ...
-
セルをクリック⇒そのセルに入力...
-
Excelでのコメント表示位置
-
エクセル 足して割る
-
excelのCOUNTIF関数で、『範囲=...
-
EXCEL VBA セルに既に入...
-
エクセル オートフィルタで絞...
-
エクセルのセルの枠を超えて文...
-
(Excel)数字記入セルの数値の後...
-
エクセルの一つのセルに複数の...
-
【Excel】 セルの色での判断は...
-
Excel2003 の『コメント』の編...
-
エクセル “13ヶ月”を“1年1ヶ月...
-
複数のセルのいずれかに数字が...
-
枠に収まらない文字を非表示に...
-
excelの特定のセルの隣のセル指...
おすすめ情報