おはようございます
前回、ローマ字、ハイフンを含む並び替えで正規表現を用いての並び替えを教えていただきました。その際A列を例題として解答していただきましたが、列(G列11行~最終行)を変更して行った結果うまくいきません大変申し訳ありませんがお教えください。
Sub Q12878498()
Dim re As Object, mc As Object
Dim n As Long, v()
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "^(\D+)?(\d+)-?(\d+)?$"
n = Cells(Rows.Count, 1).End(xlUp).Row
If n < 2 Then Exit Sub
ReDim v(1 To n, 1 To 3)
For rw = 2 To n
Set mc = re.Execute(Cells(rw, 1).text)
If mc.Count > 0 Then
v(rw, 1) = mc.Item(0).SubMatches(0) & " "
v(rw, 2) = mc.Item(0).SubMatches(1)
v(rw, 3) = mc.Item(0).SubMatches(2)
If v(rw, 3) = "" Then v(rw, 3) = -1
End If
Next rw
Application.ScreenUpdating = False
Range("A:C").Insert
Cells(1, 1).Resize(n, 3).Value = v
Cells(2, 1).Resize(n - 1, 4).Sort _ 'ソート範囲はCells(2, 1).Resize(n - 1, 5)
key1:=Range("A2"), key2:=Range("B2"), key3:=Range("C2")
Range("A:C").Delete
Application.ScreenUpdating = True
End Sub
上記のVBAにより、わかる範囲でセル(行、列)を変更してみました行変更に対しては何とかできましたが列を変更するとできません。どこの箇所を変更したらよいのでしょうか。
No.5ベストアンサー
- 回答日時:
こんばんは
前回回答者です。
>A列を例題として解答していただきましたが、列(G列11行~最終行)
>を変更して行った結果うまくいきません
今更ですが、セル位置程度の話であれば、初めからその位置でご質問をなされば面倒な問題は起きなかったのにと思います。
また、「前回」としか書いていないので、どのような質問だったのかは他の方には読み取れない可能性があります。
(プロフィールで質問履歴を非公開にしていますし)
コードだけ見せられても(処理の内容は理解できても)、「実際になさりたいこと」を読み解くのは面倒なことですので。
既に、他の方が回答してくださっているので、そちらをご利用なさっても宜しいかと思いますが、ひとまず回答した手前、ご質問のコードをそのままの形式で書き直してみました。
※ 並べ替えの対象となるセル範囲の1行目を、targetCellsとして設定しておきます。
(G11がタイトル行の場合は、実データの始まるG12:H12に修正してください)
※ このtargetCellsの示す範囲に対して、処理が行われるように内容を変更しました。
(一部のロジックを微修正してあります。)
Sub Q12883177()
Dim re As Object, mc As Object
Dim tr As Range, n As Long, v()
Const targetCells = "G11:H11" '←並べ替え対象の範囲
Set tr = Range(targetCells).Rows(1).Cells
n = Cells(Rows.Count, tr(1).Column).End(xlUp).Row - tr(1).Row + 1
If n < 1 Then Exit Sub
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "^(\D+)?(\d+)-?(\d+)?$"
ReDim v(1 To n, 1 To 3)
For rw = 1 To n
Set mc = re.Execute(tr(1).Offset(rw - 1).text)
If mc.Count > 0 Then
v(rw, 1) = mc.Item(0).SubMatches(0) & " "
v(rw, 2) = mc.Item(0).SubMatches(1) * 1
v(rw, 3) = mc.Item(0).SubMatches(2)
If v(rw, 3) = "" Then v(rw, 3) = -1
v(rw, 3) = v(rw, 3) * 1
End If
Next rw
Application.ScreenUpdating = False
tr(1).Resize(, 3).EntireColumn.Insert
tr(1).Offset(, -3).Resize(n, 3).Value = v
tr(1).Offset(, -3).Resize(n, tr.Columns.Count + 3).Sort _
key1:=tr(1).Offset(, -3), key2:=tr(1).Offset(, -2), key3:=tr(1).Offset(, -1)
tr(1).Offset(, -3).Resize(, 3).EntireColumn.Delete
Application.ScreenUpdating = True
End Sub
質問の要領を得ず大変失礼いたしました。並べ替え対象の範囲を変更(リセット)することで、列にこだわりなく並び替えが出来てすばらしいです。正規表現を用いての並び替え大変勉強になりました。ありがとうございました。
No.7
- 回答日時:
こんにちは
大分にぎわいましたが、
>Range("b11:x" & zsg).Sort key1:=Range("g11") ・・・・
となると 部分的な並び替えではない ので大分内容が異なりますね
各キーのデータの作り方は前出の関数でおおよそ想像できるのですが
今回は、各Key列はどこから作られるのでしょう?と思います。
g11 i11 j11 各列最終行まで の値(元データ)を
アルファベット 数値 数値 に加工してSortキーワードにするのでしょうか?
ご質問の流れからキーが9列?・・・
私が回答できるかは分かりませんが、整理して 再質問されるのが良いと思いますね
(元データのパターンは明確に)
アルファベットだけの値の有無とか大文字の有無、優先順位とか・・・(現状大文字が優先)
回答追加した ついでに
#4の文字列作成、加工部分をVBScript.RegExpで取得すると
For i = 1 To UBound(ary, 1)
Dim reg As Object
Set reg = CreateObject("VBScript.RegExp")
reg.Pattern = "^(\D+)?(\d+)-?(\d+)?$"
With reg.Execute(ary(i, 1))
If .Count > 0 Then
If .Item(0).SubMatches(2) <> "" Then
ary(i, colm) = .Item(0).SubMatches(1) * 1000 + .Item(0).SubMatches(2)
Else
ary(i, colm) = .Item(0).SubMatches(1) * 1000
End If
If .Item(0).SubMatches(0) <> "" Then ary(i, colm) = .Item(0).SubMatches(0) & ary(i, colm)
Else
ary(i, colm) = "zz" & ary(i, 1) & 10 ^ i '文字列のみの場合の最下位に回す対応(シートソートでないのでやっつけ)
End If
End With
Next i
優先キーを作成するのが大変なので数値加工で対応しているので
破綻する可能性があります?
文字列のみをアルファベット順位(数値があるもの)に組み込む場合は
\D+ を小文字にして対応してください(現状最下位)
私的には配列より正規表現の方が判り難いと思いますが慣れかな?
No.6
- 回答日時:
No3です。
>ソートできましたが、文字例 1-1等が1/1/2022ように日付表示されました。
前回のは破棄してください。こちらを採用してください。
なお、必ず実行前にG列の「セルの書式設定」を文字列に設定してください。
Public Sub 指定列ソート()
Const 処理列 As String = "G"
Const 開始行 As Long = 11
Dim RE As Object
Dim mc As Object
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim maxrow As Long
Dim row1 As Long
Dim row2 As Long
Set RE = CreateObject("VBScript.RegExp")
RE.Pattern = "^(\D+)?(\d+)-?(\d+)?$"
Set sh1 = ActiveSheet
maxrow = sh1.Cells(Rows.count, 処理列).End(xlUp).Row
If maxrow < 開始行 Then Exit Sub
Application.ScreenUpdating = False
Worksheets.Add after:=Worksheets(Worksheets.count)
Set sh2 = Worksheets(Worksheets.count)
sh2.Columns("D:D").NumberFormatLocal = "@"
row2 = 0
For row1 = 開始行 To maxrow
row2 = row2 + 1
Set mc = RE.Execute(sh1.Cells(row1, 処理列).text)
If mc.count > 0 Then
sh2.Cells(row2, "A").Value = mc.Item(0).SubMatches(0) & " "
sh2.Cells(row2, "B").Value = mc.Item(0).SubMatches(1)
sh2.Cells(row2, "C").Value = mc.Item(0).SubMatches(2)
If sh2.Cells(row2, "C").Value = "" Then sh2.Cells(row2, "C").Value = -1
End If
sh2.Cells(row2, "D").Value = sh1.Cells(row1, 処理列).Value
Next
sh2.Cells(1, 1).Resize(maxrow - 開始行 + 1, 4).Sort key1:=Range("A1"), key2:=Range("B1"), key3:=Range("C1")
sh1.Cells(開始行, 処理列).Resize(maxrow - 開始行 + 1, 1).Value = sh2.Cells(1, "D").Resize(maxrow - 開始行 + 1, 1).Value
Application.DisplayAlerts = False
sh2.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
No.4
- 回答日時:
こんにちは、#2で回答したものです
状況は良く分かりませんが、お示しのコードに手を加えるのは控えさせて頂き、アイデアについては#3様が回答されていますので前回
https://oshiete.goo.ne.jp/qa/12878498.html
のご質問で私が回答したものに手を加えてコードにしてみます
文字列はローマ字、数値、ハイフンとの組み合わせと理解していますが
明確な文字列パターンが不明なのでVBScript.RegExpを呼ばず
Like "[0-9-@]" と取敢えず1文字ずつ取得して、前での関数式を基に数値を作り順位キーワードにしています。
明確な文字列パターンがあるようならば、ご質問のコードにあるようにVBScript.RegExpを呼び、処理をされるのが良いと思います。
今回も内容が分からないと思いますが、 配列でのソート
Sub mySort_alphabet_hyphen()
Call ArrayInsertionSort _
(Range(Cells(11, "G"), Cells(Rows.Count, "G").End(xlUp)).Resize(, 5))
End Sub
Sub ArrayInsertionSort(Rng As Range)
Dim ary(), tp(), s
Dim i As Long, n As Long, k As Long, colm As Long
Dim moji As String
Dim tmp1, tmp2
If Rng.Count <= 1 Then Exit Sub
ary = Rng.Value
ReDim Preserve ary(1 To UBound(ary, 1), 1 To UBound(ary, 2) + 1)
colm = UBound(ary, 2)
ReDim tp(1, 1 To colm)
For i = 1 To UBound(ary, 1)
'文字列作成
For k = 1 To Len(ary(i, 1))
moji = Mid(ary(i, 1), k, 1)
If moji Like "[0-9-@]" Then tmp1 = tmp1 & moji Else tmp2 = tmp2 & moji
Next
'文字(数値)加工・・ 配列へ 2が加工数値
n = n + 1: s = Split(tmp1, "-")
If tmp1 <> "" Then
If tmp2 = "" Then
If UBound(s) = 0 Then ary(n, colm) = s(0) * 1000 Else ary(n, colm) = s(0) * 1000 + s(1)
Else
If UBound(s) = 0 Then ary(n, colm) = tmp2 & s(0) * 1000 Else ary(n, colm) = tmp2 & s(0) * 1000 + s(1)
End If
End If
tmp1 = "": tmp2 = ""
Next
'配列次元 UBoundキーで挿入Sort
For n = LBound(ary) + 1 To UBound(ary)
For i = 1 To colm
tp(1, i) = ary(n, i)
Next
If ary(n - 1, colm) > tp(1, colm) Then
k = n
Do While k > LBound(ary)
If ary(k - 1, colm) <= tp(1, colm) Then
Exit Do
End If
For i = 1 To colm
ary(k, i) = ary(k - 1, i)
Next
k = k - 1
Loop
For i = 1 To colm
ary(k, i) = tp(1, i)
Next
End If
Next
'結果出力
Rng(1).Resize(UBound(ary), colm - 1) = ary
End Sub
実行プロシージャ
Sub mySort_alphabet_hyphen()
Call ArrayInsertionSort _
(Range(Cells(11, "G"), Cells(Rows.Count, "G").End(xlUp)).Resize(, 5))
G11セルから最終行の範囲をResize(, 5)右に拡張した範囲が対象
並び替えキーワード列は一番左の列、範囲は可変
並び替え数値(加工数値)は2次元側最大に格納
降順はソート部分不等式を反転及び変更
注意* '結果出力は Rng(1). なので上書きされます。
テストされる場合は、コピーブックなどで
実験データ 左が前
期待する順番になっていない様であれば
キーワードに問題があるので '文字列作成、文字(数値)加工を検討してください。
No.3
- 回答日時:
以下のようにしてください。
もし、現行のA列2行からに変えたい場合は、
Const 処理列 As String = "G"
Const 開始行 As Long = 11
を
Const 処理列 As String = "A"
Const 開始行 As Long = 2
にしてください。
上記を変更すれば、任意のセルのソートができます。
----------------------------------------------------------
Public Sub 指定列ソート()
Const 処理列 As String = "G"
Const 開始行 As Long = 11
Dim RE As Object
Dim mc As Object
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim maxrow As Long
Dim row1 As Long
Dim row2 As Long
Set RE = CreateObject("VBScript.RegExp")
RE.Pattern = "^(\D+)?(\d+)-?(\d+)?$"
Set sh1 = ActiveSheet
maxrow = sh1.Cells(Rows.count, 処理列).End(xlUp).Row
If maxrow < 開始行 Then Exit Sub
Application.ScreenUpdating = False
Worksheets.Add after:=Worksheets(Worksheets.count)
Set sh2 = Worksheets(Worksheets.count)
row2 = 0
For row1 = 開始行 To maxrow
row2 = row2 + 1
Set mc = RE.Execute(sh1.Cells(row1, 処理列).text)
If mc.count > 0 Then
sh2.Cells(row2, "A").Value = mc.Item(0).SubMatches(0) & " "
sh2.Cells(row2, "B").Value = mc.Item(0).SubMatches(1)
sh2.Cells(row2, "C").Value = mc.Item(0).SubMatches(2)
If sh2.Cells(row2, "C").Value = "" Then sh2.Cells(row2, "C").Value = -1
End If
sh2.Cells(row2, "D").Value = sh1.Cells(row1, 処理列).Value
Next
sh2.Cells(1, 1).Resize(maxrow - 開始行 + 1, 4).Sort key1:=Range("A1"), key2:=Range("B1"), key3:=Range("C1")
sh1.Cells(開始行, 処理列).Resize(maxrow - 開始行 + 1, 1).Value = sh2.Cells(1, "D").Resize(maxrow - 開始行 + 1, 1).Value
Application.DisplayAlerts = False
sh2.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
回答していただきありがとうございました。早々マクロを実行させていただきました。ソートできましたが、文字例 1-1等が1/1/2022ように日付表示されました。書式設定の変更等で試みてみます。参考にさせていただきます。
No.2
- 回答日時:
こんばんは
書かれた方を待つのが良いと思いますが、
自身で出来そうなアイデアとして
A列で実行すれば出来るのであれば、(大前提)
並び替えたい範囲(元データ)を別シート(新規シートなど)A列以降に書き出し、
別シートで処理を実行
結果を元データ範囲に代入
元データの貼り付け と 加工データの取得処理を加えるだけになると思います。
列の挿入や削除があるので、その方が判り易いかな。。
ありがとうございます。シートに問題があるのかパソコンに問題があるか一応新しいシートで処理実行したりパソコンを再起動したりして確認しておりますが解決に至っていません。いろいろ試しているところです。
No.1
- 回答日時:
直接の回答ではありませんが。
個人的には Cells で行・列を指定するとき、特に列の場合は列番号より列記号を用いるようにしてますね。
例えばセルA1なら
Cells(1 , 1) よりも Cells(1 , "A") の方が Range("A1") に表示が近いので、わかりやすくなるかなと初級レベルなジジィは思ってしまうので。
ありがとうございます。
RangeとCells の表示方法はいろいろありますが、変数を組み込むような場合にはCells(j , 1) と使用するのが良いかと思います。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) なぜExit Subがあるのかわかりません 4 2023/02/19 12:34
- Visual Basic(VBA) 配列の勉強をしています。使用する変数の意味、検索条件の書き方が難しいです。 2 2022/09/15 14:06
- Visual Basic(VBA) excel vbaでvlooupの変数がわかりません。 7 2022/05/30 09:35
- Excel(エクセル) VBAの指示の内容 昨日こちらでご教示頂いたのですが初心者な為、一つ一つの指示が何をやっているのかわ 2 2022/10/25 18:08
- Visual Basic(VBA) VBA処理追加 こちらでご教示頂いたのですが回答完了させてしまいましたのでこちらからまた質問させてく 2 2022/10/27 09:57
- Visual Basic(VBA) ExcelVBAで、index、match関数を使用して、指定範囲に出力したい 3 2022/10/18 21:53
- Visual Basic(VBA) 前回ご教授いただいたコードに覚えたてのループ処理で品名りんごAから順に20回for nextでループ 7 2023/01/13 22:01
- Excel(エクセル) VBAで組み合わせ算出やCOUNTIFSの処理を高速化したいです。 4 2022/04/07 02:38
- Visual Basic(VBA) まとめシートから集計シートへA列のコードが一致したら1行コピーするマクロをネット上で見つけました。こ 1 2022/08/30 14:11
- Visual Basic(VBA) オブジェクトが見つかりません 1 2023/06/24 19:43
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelで、あるセルの値に応じて...
-
B列の最終行までA列をオート...
-
IIF関数の使い方
-
Worksheets メソッドは失敗しま...
-
Cellsのかっこの中はどっちが行...
-
VBAのFind関数で結合セルを検索...
-
VBA 何かしら文字が入っていたら
-
【VBA】2つのシートの値を比較...
-
targetをA列のセルに限定するに...
-
Changeイベントでの複数セルの...
-
VBAを使って検索したセルをコピ...
-
VBAコンボボックスで選択した値...
-
データグリッドビューの一番最...
-
別シートのデータを参照して値...
-
vba 2つの条件が一致したら...
-
URLのリンク切れをマクロを使っ...
-
VBA 値と一致した行の一部の列...
-
マクロ 最終列をコピーして最終...
-
エクセル 2つの表の並べ替え
-
エクセルについて
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Worksheets メソッドは失敗しま...
-
Excelで、あるセルの値に応じて...
-
B列の最終行までA列をオート...
-
vba 2つの条件が一致したら...
-
Cellsのかっこの中はどっちが行...
-
VBAを使って検索したセルをコピ...
-
文字列の結合を空白行まで実行
-
VBAのFind関数で結合セルを検索...
-
IIF関数の使い方
-
【VBA】2つのシートの値を比較...
-
マクロ 最終列をコピーして最終...
-
VBA 何かしら文字が入っていたら
-
Changeイベントでの複数セルの...
-
URLのリンク切れをマクロを使っ...
-
エクセルVBAにて =A1=B1とすれ...
-
VBAでのリスト不一致抽出について
-
データグリッドビューの一番最...
-
マクロについて。S列の途中から...
-
VBA UserFormからの転記で
-
targetをA列のセルに限定するに...
おすすめ情報
質問の要領を得ず大変失礼いたしました。最初から私のやろうとしたことをストレートに質問すればよかったのですが初めてのことで安易に考えてしまいました。例題としてA列を取り上げましたが実際はG列を含め表自体としてのB列から挿入行を含めX列までの並び替えです。
Range("b11:x" & zsg).Sort _
key1:=Range("g11") _
, order1:=xlAscending, _
key2:=Range("i11") _
, order2:=xlAscending, _
key3:=Range("j11") _
, order3:=xlAscending, DataOption3:=xlSortTextAsNumbers