[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『以下の場合、どのようなVBAコードになるでしょうか？』（CBR1000RR）
以下のような実行結果が出力されるマクロコードを教えて頂きたく。
元ファイル
|C |G|M |Q 3 |P01|1|○|SD2,5-FAEFA-34P-DS 4 |P01|2|○|D-SW2,5-WWEFD 5 |P01|1|○|SD2,5-FAEFA-23P-DS 6 |P01|2| |D-SW2,5-WWEFD 7 |P01|1|○|SD2,5-FAEFA-100P-DS 8 |P01|2|○|D-SW2,5-WWEFD 9 |P01|1| |SD2,5-FAEFA-98P-DS 10|P01|2| |D-SW2,5-WWEFD 11|P01|1|○|SD2,5-FAEFA-3P-DS 12|P01|2|○|D-SW2,5-WWEFD 13|P01|1|○|SD2,5-FAEFA-32P-DS 14|P01|1| |SD2,5-34P-AS 15|P01|2|○|D-SW2,5 16|P01|1|○|SD2,5-100P-AS 17|P01|2|○|D-SW2,5 18|P01|1|○|SD2,5-36P-AS 19|P01|2|○|D-SW2,5 20| | | | 21| | | | 23| | | | 24| | | | 25| | | | 26| | | | 27| | | | 28|P20|1|○|SD2,5-FAEFA-34P-DS 29|P20|2|○|D-SW2,5-WWEFD 30|P20|1|○|SD2,5-FAEFA-64P-DS 31|P20|2|○|D-SW2,5-WWEFD
実行結果
|C |G|M |Q 3|P01|1|○|SD2,5-FAEFA-192P-DS 4|P01|6|○|D-SW2,5-WWEFD 5|P01|1|○|SD2,5-136P-AS 6|P01|6|○|D-SW2,5 7|P20|1|○|SD2,5-FAEFA-98P-DS 8|P20|4|○|D-SW2,5-WWEFD
M列に○がある行に関してのみが対象となります。
Q列にて特定の文字列で、その文字列の特定の箇所の数値を合算する。
例の場合、特定の文字列はSD2,5-FAEFA-**P-DSとSD2,5-**P-ASになり、その他はG列の数値を合算する。
C列の文字列が異なる場合(例にはP01,P20と記載されていますが、仮です)、別々に合算する。
以上のような感じで、御願い致します。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
質問です。
１．2行目はタイトル行ですか？ ２．M列、○以外は空白（"" などではなく本当の空白）と考えていいですか。 それとも別の文字が入っているケースもあるのですか？ ３．C列が異なる場合は別々に合算ということですけど、アップされた例では同じP01でも別々に合算されていますね。 C列以外にまとめるべきキーがあるのですか？ それはどこですか？ ４．一番わからないところ。
>>Q列にて特定の文字列で、その文字列の特定の箇所の数値を合算する。 >>例の場合、特定の文字列はSD2,5-FAEFA-**P-DSとSD2,5-**P-ASになり、その他はG列の数値を合算する。
この特定の文字列って、どう判断するのですか？ 例では、こうだ という説明がありますが、そのほかの例では、また 別の文字列が特定の文字列になるのですか？
（β） 2016/02/02(火) 19:56
すこ〜し、わかってきましたが。
合算キーは C列 + Q列 なんですね。 で、Q列は、たとえば
SD2,5-FAEFA-34P-DS
と
SD2,5-FAEFA-23P-DS
は、同じ （34 と 23 は ** 扱い）とみなしたいのですね？
であれば、そのパターン、こういったものは同じとみなすという文字列を列挙してください。
もしかしたら
SD3,5-FAEFA-34P-DS
というのがあって SD3 も SD* とみなしたいかもしれませんよね。 でも SD3 は SD3、SD2 とは違うんですよね。
そのルールをすべて列挙してください。
（β） 2016/02/02(火) 20:05
もう１つ。
Ｑ列の1つのセル内に、その特定文字列が複数種類あって、それぞれを合算しなければいけないのですか？ それとも、１つのセル内には、その特定文字列があったとしても１つだけ（1か所だけ）ですか？
（β） 2016/02/02(火) 20:16
もう１つ。
結果の 3|P01|1|○|SD2,5-FAEFA-192P-DS
なぜ G列が 1 なんですか？
（β） 2016/02/02(火) 21:01
とりあえず、想像しまくりで。 1種類の指定文字列を与えて実行します。 C列やQ列の文字列の中には 改行コードやタブコードといった特殊文字はないという前提。 元シートが "Sheet1"、集約結果を "Sheet2" に転記しています。
以下の Test を実行してください。
Sub Test()
MainProc "FAEFA" '特定文字指定
End Sub
Sub MainProc(myWord As String)
Dim reg As Object
Dim dic As Object
Dim c As Range
Dim key As Variant
Dim n As Long
Dim w As Variant
Dim vC As Variant
Dim vG As Variant
Dim vM As Variant
Dim vQ As Variant
Dim x As Long
Dim tmp As Variant
Set reg = CreateObject("VBScript.RegExp")
Set dic = CreateObject("Scripting.Dictionary")
reg.Pattern = "(" & myWord & ")-(\d+)"
With Sheets("Sheet1") '★元シート
For Each c In .Range("C3", .Range("C" & Rows.Count).End(xlUp))
With c.EntireRow
If .Range("M1").Value = "○" Then
key = .Range("Q1").Value
n = 0
If reg.Test(key) Then
n = reg.Execute(key)(0).submatches(1)
key = reg.Replace(key, "$1-" & vbTab)
End If
key = .Range("C1").Value & vbLf & key
If dic.exists(key) Then
w = dic(key)
Else
w = Array(0, 0)
End If
w(0) = w(0) + .Range("G1").Value
w(1) = w(1) + n
dic(key) = w
End If
End With
Next
End With
With Sheets("Sheet2") '★転記シート
.Cells.ClearContents
ReDim vC(1 To dic.Count, 1 To 1)
vG = vC
vM = vC
vQ = vC
For Each key In dic
x = x + 1
tmp = Split(key, vbLf)
vC(x, 1) = tmp(0)
w = dic(key)
If tmp(1) Like "*" & vbTab & "*" Then tmp(1) = Replace(tmp(1), vbTab, w(1))
vQ(x, 1) = tmp(1)
vG(x, 1) = w(0)
vM(x, 1) = "○"
Next
.Range("C3").Resize(dic.Count).Value = vC
.Range("G3").Resize(dic.Count).Value = vG
.Range("M3").Resize(dic.Count).Value = vM
.Range("Q3").Resize(dic.Count).Value = vQ
.Select
End With
End Sub
（β） 2016/02/02(火) 21:25
回答が遅れてしまい申し訳ありません。
１．2行目はタイトル行ですか？ ⇒いいえ、文字列は存在しますが、無視して下さい。 ２．M列、○以外は空白（"" などではなく本当の空白）と考えていいですか。 それとも別の文字が入っているケースもあるのですか？ ⇒はい、空白と捉えて下さい。 ３．C列が異なる場合は別々に合算ということですけど、アップされた例では同じP01でも別々に合算されていますね。 C列以外にまとめるべきキーがあるのですか？ それはどこですか？ ⇒C列が異なる場合は別々に合算という意味になります、 P01でも別々というのは、SD2,5-FAEFA-192P-DSとSD2,5-136P-ASのことを指していますか？ 今回の例では特定の文字列というのはSD2,5-FAEFA-**P-DSが一つ、 そしてSD2,5-**P-ASがもう一つになります。 それらは実行結果に示しているようにG列の合算はせずにQ列の文字列内で**Pという特定の箇所の合算のみを行いたいです。 ではG列の1とは何かと言いますと、1式と捉えて下さい。 ４．一番わからないところ。
>>Q列にて特定の文字列で、その文字列の特定の箇所の数値を合算する。 >>例の場合、特定の文字列はSD2,5-FAEFA-**P-DSとSD2,5-**P-ASになり、その他はG列の数値を合算する。
この特定の文字列って、どう判断するのですか？ 例では、こうだ という説明がありますが、そのほかの例では、また 別の文字列が特定の文字列になるのですか？ ⇒特定の文字列はSD2,5-FAEFA-(数値)P-DSとSD2,5-(数値)P-ASの二つのみです。 この二つ以外は存在しないと考えて下さい。 次の質問にあるSD3,5-FAEFA-(数値)P-DSとかSD4,5-(数値)-ASなどといったパターンは有りません。 SD2,5は固定で比較としてはSD2,5-の後に数値が来るか、FAEFAが来て数値が来るかの2パターンになります。
現在、頂いたコードでテスト中です。
（CBR1000RR） 2016/02/03(水) 08:58
御無理を承知で御願いします。
↓↓コードに上記のコードを組み込みたいです。
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Sub test0(ByRef wb As Workbook)
Dim ws As Worksheet
Dim shT As Worksheet
For Each ws In wb.Worksheets
With ws
'シートのCells(3,"C")が空白だったら次のシートへ
If .Cells(3, "C") = "" Then
GoTo Continue
End If
.Range("B3:S" & .Cells(Rows.Count, "C").End(xlUp).Row).Sort _
key1:=.Cells(3, "C"), order1:=xlAscending
Dim i As Long: i = 2 '対象データの先頭行番号 - 1
Dim Cnum As Long
Dim strC As String
Dim strD As String
Cnum = 0
strC = ""
strD = ""
'ステップ３,４ 3行目以降でループ
Do
i = i + 1
'ステップ１の条件をチェックして不要だったら行削除
Do While InStr(1, .Cells(i, "M"), "○") < 1 And _
i <= .Cells(Rows.Count, "C").End(xlUp).Row
.Rows(i).Delete shift:=xlUp
Loop
Dim c As String: c = .Cells(i, "C")
Dim Q As String: Q = .Cells(i, "Q")
Dim r As String: r = .Cells(i, "R")
Dim D As String: D = .Cells(i, "D")
'ステップ５で使うD列の文字列取得
Dim Dnum As String, k As Long, l As Long
Dnum = ""
For k = 4 To .Cells(Rows.Count, "D").End(xlUp).Row
If .Range("D" & k).Value <> "" Then
For l = 1 To 3
If Mid(.Range("D" & k).Value, l, 1) Like "[0-9]" Then
Dnum = Dnum & Mid(.Range("D" & k).Value, l, 1)
End If
Next l
Exit For
End If
Next k
Dim j As Long
j = i
'i行の次の行から最終行までループ
Do
j = j + 1
'ステップ１の条件をチェックして行を削除
Do While InStr(1, .Cells(j, "M"), "○") < 1 And _
j <= .Cells(Rows.Count, "C").End(xlUp).Row
.Rows(j).Delete shift:=xlUp
Loop
'C,Q,Rの各列が全て一致したとき
If .Cells(j, "C") = c And _
.Cells(j, "Q") = Q And _
.Cells(j, "R") = r Then
'ステップ２ G列の数値をCells(i,"G")に加算
.Cells(i, "G") = .Cells(i, "G") + .Cells(j, "G")
.Rows(j).Delete shift:=xlUp
j = j - 1
End If
Loop While j < .Cells(Rows.Count, "C").End(xlUp).Row
If strC = c Then
Cnum = Cnum + 1
Else
Cnum = 1
strC = c
End If
'ステップ５書き出し
.Cells(i, "AC") = CLng(Dnum) & "-" & c & "-" & CStr(Cnum)
'ステップ６
If c = "S01" Then
.Cells(i, "AD") = "M_MERKER"
Else
.Cells(i, "AD") = "B_MERKER"
End If
If .Range("AC2").Value = "" Then
.Range("AC2").Value = "NUMBER"
End If
If .Range("AD2").Value = "" Then
.Range("AD2").Value = "PLAE"
End If
Loop While i < .Cells(Rows.Count, "C").End(xlUp).Row
Continue:
End With
Next
End Sub
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
やってることは
M列に○が無い行は削除します。
残った行で、
D4以降の列の文字列の頭の数値を記憶しておきます(1)
次に各行のC列、Q列、R列が文字列として一致する場合、その行のG列の数値を合算して
その後、合算された行は削除されます。(2)
AC列に先程の(1)とC列の文字列と追番を“−”繋ぎで記載します。(3)
AD列にはC列で“S01”となっている行とそうでない行で記載内容を変えています。(4)
以上がやっている内容です。
そこへ
追加機能として
Q列で特定文字列が出た場合には、(2)とは異なる処理を行いたい。
それが最初の質問内容になります。
同じ特定文字列が各行にあった場合には、Q列のセル内で合算して
その後、合算された行は削除し、G列は1のまま(1式と見なします)
もちろん、(3)と(4)も実施します。
どうでしょうか？
（CBR1000RR） 2016/02/03(水) 10:35
とりあえず、私の質問に対するお返事に関して。
・⇒いいえ、文字列は存在しますが、無視して下さい。
了解です。最初に フィルターオプションやオートフィルターが使えるかなと思い質問しましたが、結局はフィルタリング関連のメソッドは 使いませんでしたので忘れてください。
・⇒はい、空白と捉えて下さい。
了解です。これも、○ではない領域を SpecialCellsで取得できるかなとの思い付きです。 もしかしたら、今後、アップした処理案を改定していく中で、使うかもしれません。
・⇒C列が異なる場合は別々に合算という意味になります、 P01でも別々というのは、SD2,5-FAEFA-192P-DSとSD2,5-136P-ASのことを指していますか？ 今回の例では特定の文字列というのはSD2,5-FAEFA-**P-DSが一つ、 そしてSD2,5-**P-ASがもう一つになります。
これについては、まだ、いまいちわかりまえん。 想像しまくりで作ったロジックでは、合算キーは P01 等（C列) と SD2,5-FAEFA-23P-DS 等（Q列）をあわえたものと考えていて ただし、Q列 の FAEFA-23は FAEFA-** として FAEFA-34 も FAEFA-** 、だから同じとみなす。たぶんここまではＯＫなんでしょうね。
ただ、アップしたロジックでは SD2,5-36P-AS の 36 の部分も ** という把握はしていませんでしたので、2種類ということで 変更が必要ですね。 つまり SD2,5-数字 も対応するということですね。
だけど、SD2,5-36P-AS と SD2,5-FAEFA-23P-DS は別物と考えていいのですよね？
・それらは実行結果に示しているようにG列の合算はせずにQ列の文字列内で**Pという特定の箇所の合算のみを行いたいです。 ではG列の1とは何かと言いますと、1式と捉えて下さい。
ここもよくわかりません。G列が1式であろうと1個であろうと1セットであろうと構わないのですが、アップされた実行結果を見ると ６ がある。元データには １ と ２ しかない。なので、同じキーのＧ列を足しているんだろうなと思うのですが、 それにしては、SD2,5-FAEFA-192P-DS が 1 というのがよくわからないんです。
★逆に D-SW2,5-WWEFD は、なぜ 6 なんですか？
・特定の文字列はSD2,5-FAEFA-**P-DSとSD2,5-**P-ASになり、その他はG列の数値を合算する。
G列については、まだ、よくわかりませんが、特定文字列については了解です。
★実は質問のポイントは、
これらの特定文字列が １つのセルに 同時に２つ以上登場することはありますか？ ということでした。 つまり、Q列のどこかのセルに SD2,5-36P-AS-Hoge-SD2,5-FAEFA-23P-DS なんてのが出てくる可能性もあるのかどうか？
●今から外出。戻りは深夜になりますので、対応はしばらくお待ちください。 もちろん、他の回答者さんたちからの回答が、それ以前にあるかもしれないですし、そうなればβもうれしいです。
（β） 2016/02/03(水) 11:08
Q1:想像しまくりで作ったロジックでは、合算キーは P01 等（C列) と SD2,5-FAEFA-23P-DS 等（Q列）をあわえたものと考えていてただし、Q列 の FAEFA-23は FAEFA-** として FAEFA-34 も FAEFA-** 、だから同じとみなす。たぶんここまではＯＫなんでしょうね。ただ、アップしたロジックでは SD2,5-36P-AS の 36 の部分も ** という把握はしていませんでしたので、2種類ということで変更が必要ですね。 つまりSD2,5-数字 も対応するということですね。だけど、SD2,5-36P-AS と SD2,5-FAEFA-23P-DS は別物と考えていいのですよね？
⇒別物と考えてください。
Q2:G列が1式であろうと1個であろうと1セットであろうと構わないのですが、アップされた実行結果を見ると
６がある。元データには １ と ２ しかない。なので、同じキーのＧ列を足しているんだろうなと思うのですが、それにしては、SD2,5-FAEFA-192P-DS が 1 というのがよくわからないんです。
★逆に D-SW2,5-WWEFD は、なぜ 6 なんですか？
⇒特定文字列が有る行でのG列は1と固定して下さい。
特定文字列が無い行に限って、G列を合算して下さい。 そうすれば、D-SW2,5-WWEFDは特定文字列で無いので、G列を合算して6になり SD2,5-FAEFA-192P-DSは特定文字列なので、G列は1で固定されているため、１となる 今回の場合、SD2,5-**P-ASも特定文字列なので、Q列内で**Pは合算されますが、G列は1となります。
Q3:★実は質問のポイントは、
これらの特定文字列が １つのセルに 同時に２つ以上登場することはありますか？ ということでした。
つまり、Q列のどこかのセルに SD2,5-36P-AS-Hoge-SD2,5-FAEFA-23P-DS なんてのが出てくる可能性もあるのかどうか？
⇒無いです。
Q列で特定文字列として記載される可能性があるのは “SD2,5-FAEFA-**P-DS”と“SD2,5-**P-AS”のどち らかになります。
●今から外出。戻りは深夜になりますので、対応はしばらくお待ちください。
もちろん、他の回答者さんたちからの回答が、それ以前にあるかもしれないですし、そうなればβもうれしいです。
⇒承知しました。有難うございます。
（CBR1000RR） 2016/02/03(水) 11:38
了解です。
いずれにしても、新しい要件への組み込みは、単体としての最初のテーマがＯＫになってから取り組みましょう。
（β） 2016/02/03(水) 11:41
承知しました。
最初のテーマから順番に御願いします。
（CBR1000RR） 2016/02/03(水) 13:22
とりあえず、以下で、そちらがアップしたサンプルを元に、そちらでアップした形の転記ができました。 (ただし、出力順は、元シートの出現順ですので、ちょっと違っているところもありますが） なお、βは、このコードで使っている正規表現に関してはよちよちあるきで、まだるっこしい変換処理をしていると思います。 （エキスパートさんから見たら噴飯もののコードかもしれません）
Test->MainProc の2本立てでしたが、今回は Test2 一本です。
Sub Test2()
Dim reg As Object
Dim dic As Object
Dim c As Range
Dim key As Variant
Dim n As Long
Dim w As Variant
Dim vC As Variant
Dim vG As Variant
Dim vM As Variant
Dim vQ As Variant
Dim x As Long
Dim tmp As Variant
Dim mt As Object
Dim rep As String
Dim hit As Boolean
Set reg = CreateObject("VBScript.RegExp")
Set dic = CreateObject("Scripting.Dictionary")
reg.Pattern = "(SD2,5-+FAEFA-+)(\d+)(P-DS)|(SD2,5-+)(\d+)(P-+AS)" '指定の２つの語句決め打ち
With Sheets("Sheet1") '★元シート
For Each c In .Range("C3", .Range("C" & Rows.Count).End(xlUp))
With c.EntireRow
If .Range("M1").Value = "○" Then
key = .Range("Q1").Value
n = 0
hit = False
Set mt = reg.Execute(key)
If mt.Count > 0 Then
hit = True
If Not IsEmpty(mt(0).submatches(0)) Then
rep = "$1" & vbTab & "$3"
Else
rep = "$4" & vbTab & "$6"
End If
n = reg.Execute(key)(0).submatches(1) & reg.Execute(key)(0).submatches(4)
key = reg.Replace(key, rep)
End If
key = .Range("C1").Value & vbLf & key
If dic.exists(key) Then
w = dic(key)
Else
w = Array(0, 0)
End If
w(0) = hit
If hit Then
w(1) = w(1) + n
Else
w(1) = w(1) + .Range("G1").Value
End If
dic(key) = w
End If
End With
Next
End With
With Sheets("Sheet2") '★転記シート
.Cells.ClearContents
ReDim vC(1 To dic.Count, 1 To 1)
vG = vC
vM = vC
vQ = vC
For Each key In dic
x = x + 1
tmp = Split(key, vbLf)
vC(x, 1) = tmp(0)
w = dic(key)
If tmp(1) Like "*" & vbTab & "*" Then tmp(1) = Replace(tmp(1), vbTab, w(1))
vQ(x, 1) = tmp(1)
If w(0) Then
vG(x, 1) = 1
Else
vG(x, 1) = w(1)
End If
vM(x, 1) = "○"
Next
.Range("C3").Resize(dic.Count).Value = vC
.Range("G3").Resize(dic.Count).Value = vG
.Range("M3").Resize(dic.Count).Value = vM
.Range("Q3").Resize(dic.Count).Value = vQ
.Select
End With
End Sub
（β） 2016/02/04(木) 08:18
朝早くからの対応ありがとうございます。
こちらでも動作確認しました。
確かにD-SW2,5とSD2,5-136P-ASが逆転しています。
ですが、実行結果としては
こちらの理想通りです。
無理な願いばかりで、すみませんが
引き続き、新しい要件への組み込みをお願いします。
（CBR1000RR） 2016/02/04(木) 08:47
ほっとしました。 ところで結果オーライですが、文字列パターンで、少し勘違いしていたところがありました。
reg.Pattern = "(SD2,5-FAEFA-)(\d+)(P-DS)|(SD2,5-)(\d+)(P-AS)" '指定の２つの語句決め打ち
このようにしておいてください。そのほうが現状にあっていますし、わかりやすいですから。
新しいテーマ、今から、眺めてみます。
（β） 2016/02/04(木) 08:55
上記承知しました。
コード修正します。
新しいテーマ、宜しくお願いします。
不明点あれば、連絡ください。
（CBR1000RR） 2016/02/04(木) 09:39
まだ、新しい要件は詳細には見ていないのですが、
最初のテーマは Sheet1の内容を、最初のテーマの変換ルールで変換し、Sheet2を作成しましたね。 今回のテーマは、
１．指定ブックの全シートを ２．今回のテーマの変換ルール ＋ 最初のテーマの変換ルールで 変換し ３．そのシートを置き換える
こういうことですか？
（β） 2016/02/04(木) 10:39
今回のテーマは、
１．指定ブックの全シートを ２．今回のテーマの変換ルール ＋ 最初のテーマの変換ルールで 変換し ３．そのシートを置き換える こういうことですか？
⇒はい、その通りです。
（CBR1000RR） 2016/02/04(木) 10:48
アップされたコードはまだ読んでいませんが、説明文のみ、質問です。
>>D4以降の列の文字列の頭の数値を記憶しておきます(1)
たぶん、D3以降ですね？
D列には 123abc といったようにはいっているのですか？
>>各行のC列、Q列、R列が文字列として一致する場合
最終的には、D列の文字列先頭の数値と、集約された行の C列とを連結するということですから C,Q,R のみならず、D列の文字列の頭の数値も 比較キーになるのでは？
>>Q列で特定文字列が出た場合には、(2)とは異なる処理を行いたい。
つまり、Q列が特定文字列行なら当初の変換ロジック、特定文字列ではなかったら新しい変換ロジック。 二者択一ですね？
それとも、特定文字列行は、当初変換ロジックに加えて 新しい変換ロジックも適用するのですか？
（β） 2016/02/04(木) 13:01
たぶん、D3以降ですね？
D列には 123abc といったようにはいっているのですか？
⇒はい、D3以降です。
私のミスです、すみません。
D列には、基本的に一桁の数値が入ります。
1ABCや2ABC、もしくは3ABCといった感じです。
範囲は0〜9です。
基本的に…と述べた訳ですが
例外として、以下の2パターンがあります。
01ABCもしくは02ABCが有り得ます。
ですので、AC列では01-や、02-になります。
長々となってしまいましたが、要するに
0,1,2,3,4,5,6,7,8,9,01,02の何れかが頭の数値です。
つまり、Q列が特定文字列行なら当初の変換ロジック、特定文字列ではなかったら新しい変換ロジック。
二者択一ですね？それとも、特定文字列行は、当初変換ロジックに加えて 新しい変換ロジックも適用 するのですか？
⇒“特定文字列行は、当初変換ロジックに加えて 新しい変換ロジックも適用する”でお願いします。
新しいテーマ(新しい変換ロジック)の方では、今まで特定文字列行が有ったとしても、G列の数値を合算
していました。ですが当初変換ロジックにて特定文字列行を対処して、G列の数値合算でなく且つAC列や
AD列の処理も行いたい。
宜しくお願いします。
（CBR1000RR） 2016/02/04(木) 13:54
要件を誤解している公算大ですが、試してみてください。 質問に回答をもらっていないので、D列の数値も、集約キーに含めています。（この数値が異なれば行もわかれます） また、ステップ６ の中で
If .Range("AC2").Value = "" Then
.Range("AC2").Value = "NUMBER"
End If
If .Range("AD2").Value = "" Then
.Range("AD2").Value = "PLAE"
End If
この意味がわからなかったので、対応していません。（これら２つのセルが空白なら何かを書きこむなんてのは、マクロでやる必要ありますか？）
それと、全体の列数ですが、AC列やAD列も含めて、タイトル等が、何かしらあるという前提です。（UsedRange で列数が把握できるという前提）
なお、今回は三段ロケットになっています。実行マクロは Test3 です。
Sub Test3()
Application.ScreenUpdating = False
Call MainProc(Workbooks("目的のブック.xlsx"))
End Sub
Private Sub MainProc(wb As Workbook)
Dim ws As Worksheet
Dim reg As Object
Dim dic As Object
Dim dicG As Object
Set reg = CreateObject("VBScript.RegExp")
Set dic = CreateObject("Scripting.Dictionary")
Set dicG = CreateObject("Scripting.Dictionary")
For Each ws In wb.Worksheets
If ws.Range("C3").Value <> "" Then Call subProc(ws, dic, dicG, reg) 'シートの C3 に値があるときのみ実行
Next
End Sub
Sub subProc(ws As Worksheet, dic As Object, dicG As Object, reg As Object)
Dim c As Range
Dim key As Variant
Dim n As Long
Dim w As Variant
Dim x As Long
Dim mt As Object
Dim rep As String
Dim hit As Boolean
Dim patQ As String
Dim patD As String
Dim nD As Variant
Dim cols As Long
Dim d As Variant
dic.RemoveAll
dicG.RemoveAll
patQ = "(SD2,5-FAEFA-)(\d+)(P-DS)|(SD2,5-)(\d+)(P-AS)" '指定の２つの語句決め打ち
patD = "^\d+" '先頭の数字
'各行の C,D(先頭の数字),Q(特定文字列は数値を除外したもの),R をキーとして集約
With ws
'M列空白セルの行削除
On Error Resume Next
.Range("A1", .UsedRange).Offset(2).Columns("M").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
cols = .Range("A1", .UsedRange).Columns.Count
For Each c In .Range("C3", .Range("C" & Rows.Count).End(xlUp))
reg.Pattern = patQ
With c.EntireRow
key = .Range("Q1").Value
n = 0
hit = False
Set mt = reg.Execute(key)
If mt.Count > 0 Then
hit = True
If Not IsEmpty(mt(0).submatches(0)) Then
rep = "$1" & vbTab & "$3"
Else
rep = "$4" & vbTab & "$6"
End If
n = reg.Execute(key)(0).submatches(1) & reg.Execute(key)(0).submatches(4)
key = reg.Replace(key, rep)
End If
reg.Pattern = patD
nD = Empty
If reg.test(.Range("D1").Value) Then nD = reg.Execute(.Range("D1").Value)(0)
key = .Range("C1").Value & vbLf & nD & vbTab & key & vbTab & .Range("R1").Value
If Not dic.exists(key) Then
.Range("AC1").Value = nD & "-" & c.Value
If c.Value = "S01" Then
.Range("AD1").Value = "M_MERKER"
Else
.Range("AD1").Value = "B_MERKER"
End If
dic(key) = c.EntireRow.Resize(, cols).Value
End If
If dicG.exists(key) Then
w = dicG(key)
Else
w = Array(0, 0)
End If
w(0) = hit
If hit Then
w(1) = w(1) + n
Else
w(1) = w(1) + .Range("G1").Value
End If
dicG(key) = w
End With
Next
'シート再作成
For Each key In dic
d = dic(key)
w = dicG(key)
If w(0) Then 'Q列特定文字列
d(1, Columns("G").Column) = 1 '常に 1
'特定文字列内の数値を合計値で置換
If d(1, Columns("Q").Column) Like "*" & vbTab & "*" Then d(1, Columns("Q").Column) = Replace(d(1, Columns("Q").Column), vbTab, w(1))
Else
d(1, Columns("G").Column) = w(1) 'G列合計
End If
dic(key) = d
Next
.Range("A1", .UsedRange).Offset(2).ClearContents 'シートの3行目以降をクリア
'dic に生成した変換シートイメージを一括転記
.Range("A3").Resize(dic.Count, cols).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic.items))
End With
End Sub
（β） 2016/02/05(金) 04:27
早朝からの対応、有難うございます。
試してみました。
その前に、下記質問・疑問について回答と質問をさせて下さい。
質問に回答をもらっていないので、D列の数値も、集約キーに含めています。（この数値が異なれば行もわかれます）
⇒どの質問でしょうか(（CBR1000RR） 2016/02/04(木) 13:54 ）の回答分ではなく、別にあるということですね。 D列の役割としては、AC列に記載する頭数値の記憶のみです。 私の説明不足で、すみません。 例えばD3で1ABCと有れば、AC列では1-となります。 極端な話ですが、D列の最初に記憶した数値は、そのシート内では共通で 決め打ちして下さい。 例で言えば シート1,2,3が存在したとして
・シート１
|D 3|1ACB 4| 5|1DSF 6|1GFS 7|1GGER
・シート2
|D 3|2GSFD 4| 5|2DSF 6|2GFS 7|2GGER
・シート3
|D 3| 4|5SDF 5|5DSF 6|5GGFFS 7|5WGGER
シート1のAC列では1-となります。D3で1ACBと記載が有り頭数値：1なので、決め打ちします。
以降のD列の行は無視で構いません。
同じように
シート2のAC列では2-となり
シート3のAC列では5-となります。
組込の元コードに記載がありますので、参照下さい。
また、ステップ６ の中で
If .Range("AC2").Value = "" Then
.Range("AC2").Value = "NUMBER"
End If
If .Range("AD2").Value = "" Then
.Range("AD2").Value = "PLAE"
End If
この意味がわからなかったので、対応していません。（これら２つのセルが空白なら何かを書きこむなんてのは、マクロでやる必要ありますか？）
⇒こちらは、私の方で付け加えますので、無視して下さい。
それと、全体の列数ですが、AC列やAD列も含めて、タイトル等が、何かしらあるという前提です。（UsedRange で列数が把握できるという前提） ⇒その前提ですと、ステップ6が必要になります。
でないと“目的のブック.xlsx”にはAC列とAD列にタイトル等何もない状態です。
?@AC列の追番が有りませんでした。
1-P01-1,2,3,4といった、P01の後に付く数値が抜けていました。
?A行の並びはそのままでした
というのは、C列にP01やP20など各行に記載されているわけですが
P01が列挙されている行の間にS01が紛れている場合があります。
例で言うと
|C |Ｄ |Ｇ|Ｍ|Ｑ |Ｒ 3 |P01|1DSF |1 |○|ddd |gfh 4 |P01|1DFASF|1 |○|gse | 5 |P01|1VCB |1 | |ggfa|dffasdf 6 |P01|1JHG |2 |○|ddd |kkd 7 |P01|1HGH |5 |○|ddd |gfh 8 |P01|1DSF |1 |○|gse | 9 |P01|1DFASF|3 |○|gse | 10 |P01|1VCB |2 | |ddd |kkd 11 |P01|1JHG |3 |○|ddd |kkd 12 |P01|1HGH |4 |○|ddd |kkd 13 |P01|1DSF |7 |○|gse |dds 14 |P01|1DFASF|1 |○|ddd | 15 |S01|1VCB |1 |○|ddd |gfh 16 |S01|1JHG |1 |○|gse | 17 |S01|1HGH |1 | |ggfa|dffasdf 18 |S01|1DSF |2 |○|ddd |kkd 19 |P01|1DFASF|5 |○|ddd |gfh 20 |P01|1VCB |1 |○|gse | 21 |S01|1JHG |3 |○|ddd |kkd 22 |P01|1HGH |1 |○|ddd |gfh 23 |P01|1DSF |1 |○|gse | 24 |P01|1DFASF|1 | |ggfa|dffasdf 25 |P01|1VCB |2 |○|ddd |kkd 26 |P20|1JHG |1 |○|ddd |gfh 27 |P20|1HGH |1 |○|gse | 28 |P20|1DSF |1 | |ggfa|dffasdf 29 |P20|1DFASF|2 |○|ggfa|dffasdf 30 |P20|1VCB |3 |○|ggfa|dffasdf 31 |P21|1JHG |1 |○|gse | 32 |P21|1HGH |1 |○|ggfa|dffasdf 33 |P21|1DSF |2 |○|ggfa|dffasdf 34 |P21|1DFASF|3 | |ggfa|dffasdf 35 |P22|1VCB |1 |○|gse | 36 |P22|1JHG |1 |○|ggfa|dffasdf 37 |P22|1HGH |2 |○|ggfa|dffasdf 38 |P22|1HGH |3 |○|ggfa|dffasdf
↓↓マクロ(VBA)実行結果↓↓
|Ｃ |Ｇ|Ｍ|Ｑ |Ｒ |AC |AD 3 |P01|12|○|ddd |gfh |1-P01-1|B_MERKER 4 |P01|7 |○|gse | |1-P01-2|B_MERKER 5 |P01|11|○|ddd |kkd |1-P01-3|B_MERKER 6 |P01|7 |○|gse |dds |1-P01-4|B_MERKER 7 |P01|1 |○|ddd | |1-P01-5|B_MERKER 8 |P20|1 |○|ddd |gfh |1-P20-1|B_MERKER 9 |P20|1 |○|gse | |1-P20-2|B_MERKER 10|P20|5 |○|ggfa|dffasdf|1-P20-3|B_MERKER 11|P21|1 |○|gse | |1-P21-1|B_MERKER 12|P21|3 |○|ggfa|dffasdf|1-P21-2|B_MERKER 13|P22|1 |○|gse | |1-P22-1|B_MERKER 14|P22|6 |○|ggfa|dffasdf|1-P22-2|B_MERKER 15|S01|1 |○|ddd |gfh |1-S01-1|M_MERKER 16|S01|1 |○|gse | |1-S01-2|M_MERKER 17|S01|1 |○|gse | |1-S01-3|M_MERKER 18|S01|5 |○|ddd |kkd |1-S01-4|M_MERKER
といったイメージです。
組込みでアップしたコードだと上記のような実行結果になります。
因みにですが、AC列の記載内容は上記の実行結果です。
?B特定文字列のコードが実行されていないようです。
恐らく、D列の集約前提や
全体の列数ですが、AC列やAD列も含めて、タイトル等が、何かしらあるという前提です。（UsedRange で列数が把握できるという前提）
が影響しているのかもしれません。
以上
長々とすみませんが、宜しくお願いします。
（CBR1000RR） 2016/02/05(金) 10:19
検証深謝
午後、時間があればチェックします。
とりあえず、
>>どの質問でしょうか
（β） 2016/02/04(木) 13:01 で
最終的には、D列の文字列先頭の数値と、集約された行の C列とを連結するということですから C,Q,R のみならず、D列の文字列の頭の数値も 比較キーになるのでは？
このように投げかけています。
（β） 2016/02/05(金) 10:34
上記宜しくお願いします。
（β） 2016/02/04(木) 13:01 で 最終的には、D列の文字列先頭の数値と、集約された行の C列とを連結するということですから
C,Q,R のみならず、D列の文字列の頭の数値も 比較キーになるのでは？ このように投げかけています。
⇒比較キーにはなりません。
同じシート内であれば、C列の頭数値は同じ値のみ存在します。
C列には空白セルも存在しますので、その場合もちろんC,Q,Rは空白では有りません
C列で最初に文字列が有って、その頭数値だけ記憶しておけばOKです。
その行が3行目か5行目かはランダムですが
すみません、コードに大きく影響させていますね
質問を見落としてしまい、すみません…
特定文字列が実行されないという件ですが
今のコード実行結果は以下のようになっています。
元ファイル
|C |G|M |Q 3 |P01|1|○|SD2,5-FAEFA-34P-DS 4 |P01|2|○|D-SW2,5-WWEFD 5 |P01|1|○|SD2,5-FAEFA-23P-DS 6 |P01|2| |D-SW2,5-WWEFD 7 |P01|1|○|SD2,5-FAEFA-100P-DS 8 |P01|2|○|D-SW2,5-WWEFD 9 |P01|1| |SD2,5-FAEFA-98P-DS 10|P01|2| |D-SW2,5-WWEFD 11|P01|1|○|SD2,5-FAEFA-3P-DS 12|P01|2|○|D-SW2,5-WWEFD 13|P01|1|○|SD2,5-FAEFA-32P-DS 14|P01|1| |SD2,5-34P-AS 15|P01|2|○|D-SW2,5 16|P01|1|○|SD2,5-100P-AS 17|P01|2|○|D-SW2,5 18|P01|1|○|SD2,5-36P-AS 19|P01|2|○|D-SW2,5 20| | | | 21| | | | 23| | | | 24| | | | 25| | | | 26| | | | 27| | | | 28|P20|1|○|SD2,5-FAEFA-34P-DS 29|P20|2|○|D-SW2,5-WWEFD 30|P20|1|○|SD2,5-FAEFA-64P-DS 31|P20|2|○|D-SW2,5-WWEFD
実行結果
|C |G|M |Q 3|P01|1|○|SD2,5-FAEFA-34P-DS 4|P01|6|○|D-SW2,5-WWEFD 5|P01|1|○|SD2,5-34P-AS 6|P01|6|○|D-SW2,5 7|P20|1|○|SD2,5-FAEFA-34P-DS 8|P20|4|○|D-SW2,5-WWEFD
同じ特定文字列の行を集約することは出来ていますが
文字列内の数値が集約前の最初の行の値のままで、合算されていません。
（CBR1000RR） 2016/02/05(金) 10:49
追加連絡深謝です。
まだ、取り掛かってはいません。 (そちらの検証結果を読むのがせいいっぱいなので）
先にコメントしましたが、そちらのコードは、まだ読んでいないのですが、 仕様理解のために、一度、そのまま実行したほうがいいかもしれませんね。これからやってみます。
で、その結果を見ればわかるのかもしれませんが、
>.1-P01-1,2,3,4といった、P01の後に付く数値が抜けていました。
この 後ろの 1,2,3,4 って何ですか？
なお、ステップ６の組み込み了解です。次回アップする際にはコードに組み込んでおきます。
（β） 2016/02/05(金) 15:13
追伸です。
こちらがアップしたコードはシート全体の新しいイメージをメモリー内で作り上げて、元の内容をクリアして どさっと書き込んでいます。
ですので、行の並び順は（先にもコメントしたように）データの出現順になります。
もし、C列の昇順でよければ対応しますが。
（β） 2016/02/05(金) 15:17
もし、C列の昇順でよければ対応しますが。 ⇒はい、その方法で御願いします。
.1-P01-1,2,3,4といった、P01の後に付く数値が抜けていました。
この 後ろの 1,2,3,4 って何ですか？ ⇒上から順番に何個目といった追番です。
例ですと
|Ｃ |Ｇ|Ｍ|Ｑ |Ｒ |AC |AD 3 |P01|12|○|ddd |gfh |1-P01-1|B_MERKER 4 |P01|7 |○|gse | |1-P01-2|B_MERKER 5 |P01|11|○|ddd |kkd |1-P01-3|B_MERKER 6 |P01|7 |○|gse |dds |1-P01-4|B_MERKER 7 |P01|1 |○|ddd | |1-P01-5|B_MERKER 8 |P20|1 |○|ddd |gfh |1-P20-1|B_MERKER 9 |P20|1 |○|gse | |1-P20-2|B_MERKER 10|P20|5 |○|ggfa|dffasdf|1-P20-3|B_MERKER 11|P21|1 |○|gse | |1-P21-1|B_MERKER 12|P21|3 |○|ggfa|dffasdf|1-P21-2|B_MERKER 13|P22|1 |○|gse | |1-P22-1|B_MERKER 14|P22|6 |○|ggfa|dffasdf|1-P22-2|B_MERKER 15|S01|1 |○|ddd |gfh |1-S01-1|M_MERKER 16|S01|1 |○|gse | |1-S01-2|M_MERKER 17|S01|1 |○|gse | |1-S01-3|M_MERKER 18|S01|5 |○|ddd |kkd |1-S01-4|M_MERKER
C列の文字列をAC列に記載しますが
1-P01が上から1、２，３，４(意味は1つ目、2つ目、3つ目、4つ目)といった感じです。
1-P20が上から１，２，３
1-P21が上から１，２
連番をP**-の後に付加する形になります。
まだ、取り掛かってはいません。
(そちらの検証結果を読むのがせいいっぱいなので） ⇒長々となってしまってすみません。
宜しくお願いします。
（CBR1000RR） 2016/02/05(金) 15:27
>>⇒上から順番に何個目といった追番です。
コードをざっと眺めているんですが、ステップ５ のところの処理ですね？
どうしましょう。路線変更しましょうか。
つまり、βは追加要件を説明いただいて、それと、最初の要件をともに処理するコードを書こうとしていたんですが そうすると、ステップ５ のように 追加要件で、これからもQ/Aを重ねなければいけない予感。
そうではなく、今そちらのコード Test0 が正しいとして、その処理が終わったあとのシートを相手に、最初の要件のみを実現するコードを 書いて、アップする。
既存のシートありきなので、アップした最初のテーマの要件のコードは、そのまま使うことはできませんので そこは、直してアップ。
このほうがいいですかね？
（β） 2016/02/05(金) 15:37
今そちらのコード Test0 が正しいとして、その処理が終わったあとのシートを相手に、最初の要件のみを実現するコードを書いて、アップする。
既存のシートありきなので、アップした最初のテーマの要件のコードは、そのまま使うことはできませんのでそこは、直してアップ。
このほうがいいですかね？
⇒Call文での対応ということでしょうか？
βさんの考え方が異なっていたり、把握済みであれ以下の懸念は気にしないで下さい。
流用できる箇所は多いと思いますが、AC列とAD列の処理は再度行う必要がありそうです。
追番はTEST0で一旦記載されていますが、最初の要件を実行すると、
特定文字列の集約によって行が削減されますので、AC列とAD列の記載内容が変わってきます。
（CBR1000RR） 2016/02/05(金) 16:31
とりあえず、まだ、望みを捨てずに当初＋追加の オールインワン型で。
MainProc と SubProc を入れ替え
17:31 並び替え追加
Private Sub MainProc(wb As Workbook)
Dim ws As Worksheet
Dim reg As Object
Dim dic As Object
Dim dicG As Object
Dim dicAC As Object
Set reg = CreateObject("VBScript.RegExp")
Set dic = CreateObject("Scripting.Dictionary")
Set dicG = CreateObject("Scripting.Dictionary")
Set dicAC = CreateObject("Scripting.Dictionary")
For Each ws In wb.Worksheets
If ws.Range("C3").Value <> "" Then Call subProc(ws, dic, dicG, dicAC, reg) 'シートの C3 に値があるときのみ実行
Next
End Sub
Sub subProc(ws As Worksheet, dic As Object, dicG As Object, dicAC As Object, reg As Object)
Dim c As Range
Dim key As Variant
Dim n As Long
Dim w As Variant
Dim x As Long
Dim mt As Object
Dim rep As String
Dim hit As Boolean
Dim patQ As String
Dim patD As String
Dim nD As Variant
Dim cols As Long
Dim d As Variant
dic.RemoveAll
dicG.RemoveAll
dicAC.RemoveAll
patQ = "(SD2,5-FAEFA-)(\d+)(P-DS)|(SD2,5-)(\d+)(P-AS)" '指定の２つの語句決め打ち
patD = "^\d+" '先頭の数字
'各行の C,D(先頭の数字),Q(特定文字列は数値を除外したもの),R をキーとして集約
With ws
If .Range("AC2").Value = "" Then
.Range("AC2").Value = "NUMBER"
End If
If .Range("AD2").Value = "" Then
.Range("AD2").Value = "PLAE"
End If
cols = .Range("A1", .UsedRange).Columns.Count
reg.Pattern = patD
nD = Empty
If reg.test(.Range("D3").Value) Then nD = reg.Execute(.Range("D3").Value)(0)
'M列空白セルの行削除
On Error Resume Next
.Range("A1", .UsedRange).Offset(2).Columns("M").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
For Each c In .Range("C3", .Range("C" & Rows.Count).End(xlUp))
reg.Pattern = patQ
With c.EntireRow
key = .Range("Q1").Value
n = 0
hit = False
Set mt = reg.Execute(key)
If mt.Count > 0 Then
hit = True
If Not IsEmpty(mt(0).submatches(0)) Then
rep = "$1" & vbTab & "$3"
Else
rep = "$4" & vbTab & "$6"
End If
n = reg.Execute(key)(0).submatches(1) & reg.Execute(key)(0).submatches(4)
key = reg.Replace(key, rep)
.Range("Q1").Value = key
End If
key = .Range("C1").Value & vbLf & nD & vbTab & key & vbTab & .Range("R1").Value
If Not dic.exists(key) Then
dicAC(c.Value) = dicAC(c.Value) + 1
.Range("AC1").Value = nD & "-" & c.Value & "-" & dicAC(c.Value)
If c.Value = "S01" Then
.Range("AD1").Value = "M_MERKER"
Else
.Range("AD1").Value = "B_MERKER"
End If
dic(key) = c.EntireRow.Resize(, cols).Value
End If
If dicG.exists(key) Then
w = dicG(key)
Else
w = Array(0, 0)
End If
w(0) = hit
If hit Then
w(1) = w(1) + n
Else
w(1) = w(1) + .Range("G1").Value
End If
dicG(key) = w
End With
Next
'シート再作成
For Each key In dic
d = dic(key)
w = dicG(key)
If w(0) Then 'Q列特定文字列
d(1, Columns("G").Column) = 1 '常に 1
'特定文字列内の数値を合計値で置換
If d(1, Columns("Q").Column) Like "*" & vbTab & "*" Then d(1, Columns("Q").Column) = Replace(d(1, Columns("Q").Column), vbTab, w(1))
Else
d(1, Columns("G").Column) = w(1) 'G列合計
End If
dic(key) = d
Next
.Range("A1", .UsedRange).Offset(2).ClearContents 'シートの3行目以降をクリア
'dic に生成した変換シートイメージを一括転記
.Range("A3").Resize(dic.Count, cols).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic.items))
'C列で並び替え
.Range("C3", .Range("C" & Rows.Count).End(xlUp)).Offset(, -2).Resize(, cols).Sort Key1:=.Range("C3"), Order1:=xlAscending, Header:=xlNo
End With
End Sub
（β） 2016/02/05(金) 17:23
コードテストしました。
有難うございます。
ざっと結果を見たところ、不具合ありませんでした。
もう少し細かくチェックしてみます。
それと今更で、大変申し訳ないのですが
特定文字列を２つ⇒4つに増やしたいのですが、御願いできますか？
現状：patQ = "(SD2,5-FAEFA-)(\d+)(P-DS)|(SD2,5-)(\d+)(P-AS)"
特定文字列：SD2,5-FAEFA-**P-DS
SD2,5-**P-AS
希望：patQ = "(SD2,5-FAEFA-)(\d+)(P-DS)|(SD2,5-)(\d+)(P-AS)|(SD2,5-FAEFA-)(\d+)(P-AS)|(SD2,5-)(\d+)(P-DS)"
特定文字列：SD2,5-FAEFA-**P-DS
SD2,5-**P-AS
SD2,5-FAEFA-**P-AS(追加)
SD2,5-**P-DS(追加)
（CBR1000RR） 2016/02/05(金) 18:19
任意のパターン数に対応するようコードを変更してアップしますので、ちょっと時間ください。
それはそれとして、あと数回のやり取りで解決すると思っているんですが、トピが長くなりすぎて閲覧するのが 大変になってきましたね。
No.2 といった新しいトピを立ち上げていただけませんか。新しいコードは、その新しいトピにアップしたいので。
（β） 2016/02/06(土) 02:05
CBR1000RRさん
最初の質問内容しかみてないのと、出力方法がわからないので新規シートで
Sub test()
Dim a, i As Long, ii As Long, x, temp As String, dic As Object, myNum As Long
Set dic = CreateObject("Scripting.Dictionary")
Wit [a3].CurrentRegion.Resize(, 17)
x = Filter(Evaluate("transpose(if(" & .Columns(13).Address & _
"=""○"",row(1:" & .Rows.Count & "),char(2)))"), Chr(2), 0)
a = Application.Index(.Value, Application.Transpose(x), [{3,7,13,17}])
End With
With CreateObject("VBScript.RegExp")
.Pattern = "(SD2,5(-FAEFA)?-)(\d+)(P-[AD]S)$"
For i = 1 To UBound(a, 1)
If .test(a(i, 4)) Then
temp = Join(Array(.Replace(a(i, 4), "$1$4"), a(i, 1)), Chr(2))
If Not dic.exists(temp) Then
dic(temp) = dic.Count + 1
SwapArray a, dic.Count, i
Else
myNum = Val(.Replace(a(i, 4), "$3")) + Val(.Replace(a(dic(temp), 4), "$3"))
a(dic(temp), 4) = .Replace(a(dic(temp), 4), "$1" & myNum & "$4")
End If
Else
temp = Join(Array(a(i, 4), a(i, 1)), Chr(2))
If Not dic.exists(temp) Then
dic(temp) = dic.Count + 1
SwapArray a, dic.Count, i
Else
a(dic(temp), 2) = a(dic(temp), 2) + a(i, 2)
End If
End If
Next
End With
Sheets.Add.Cells(1).Resize(dic.Count, 4).Value = a
End Sub
Private Sub SwapArray(a, ref As Long, i As Long)
Dim ii As Long
For ii = 1 To UBound(a, 2)
a(ref, ii) = a(i, ii)
Next
End Sub
（seiya） 2016/02/06(土) 10:22
とりあえずFileをUL
http://firestorage.jp/download/b132c2f9d1e4cb5829af169a9ac654a93564fb8d
ダウンロードパスワード yedvxw7e （seiya） 2016/02/06(土) 13:19
『以下の場合、どのようなVBAコードになるでしょうか？』（CBR1000RR） その２
というトピで新しく登録します。
そちらへ新コードの方、よろしくお願いします。
（CBR１０００RR） 2016/02/06(土) 13:36
対応ありがとうございます。
テストしてみます。
（CBR１０００RR） 2016/02/06(土) 13:37
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.