[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『同名があれば連番を付けたい』（山好き）
B２以下にファイル名が記入されたセルが行方向に複数ある場合
同じ名称があればば末尾に(番号)を追加したいのですが
どうすれば良いですか ？
（結果はできれば、同じB2以下に書き込みたい）
例えば、以下のような場合なら
磐梯山.txt
ホンダ.txt
越後駒ヶ岳.txt
赤城山.txt
ホンダ.txt
草津白根山.txt
ホンダ.txt
磐梯山.txt
以下のように
磐梯山.txt
ホンダ.txt
越後駒ヶ岳.txt
赤城山.txt
ホンダ(1).txt
草津白根山.txt
ホンダ(2).txt
磐梯山(1).txt
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
とおりすがりさん方式で。
A1セルから下に元データがあるとして。
B1セルに
=REPLACE(A1,FIND(".",A1),0,IF(COUNTIF(A$1:A1,A1)>1,"("&COUNTIF(A$1:A1,A1)-1&")",""))
と入力して下へフィルコピー、その後B列をコピーしてA列へ値の貼り付けで。
（ねむねむ） 2022/02/04(金) 12:26
C列に、以下の式を入力して下へフィルコピーして希望は叶いましたが
=REPLACE(B2,FIND(".",B2),0,IF(COUNTIF(A$1:B2,B2)>1,"("&COUNTIF(A$1:B2,B2)-1&")",""))
B列が何行になるか判らないので
関数では、何処までC列のセルに計算式を書いたら良いかが確定できません。
For文でB列の使用セル分だけVBAで処理したいです。
以下を利用
For i=2 to Cells(Rows.Count, B).End(xlUp).ROW
（山好き） 2022/02/04(金) 12:37
セル番地をきちんと見ていなくてすまなかった。
元データがB列の場合は
=REPLACE(B2,FIND(".",B2),0,IF(COUNTIF(B$2:B2,B2)>1,"("&COUNTIF(B$2:B2,B2)-1&")",""))
で。
先にB列のデータをすべて入力後にC2セルの式をフィルコピーしてはどうだろうか？
（ねむねむ） 2022/02/04(金) 12:47
＞セル番地をきちんと見ていなくてすまなかった。
＞元データがB列の場合は
＞=REPLACE(B2,FIND(".",B2),0,IF(COUNTIF(B$2:B2,B2)>1,"("&COUNTIF(B$2:B2,B2)-1&")",""))
上記式（関数）で上手く処理できました。
（山好き） 2022/02/04(金) 13:01
Dim i As Long
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
cells(i,"C")=REPLACE(cells(i,"B"),FIND(".",cells(i,"B")),0,IF(COUNTIF(range("B2"):cells(i,"B"),cells(i,"B"))>1,"("&COUNTIF(range("B2"):cells(i,"B"),cells(i,"B"))-1&")",""))
Next
End Sub
（山好き） 2022/02/04(金) 13:18
こんな感じだろうか？
Sub TST()
Dim END_ROW As Integer
With Worksheets("Sheet1")
END_ROW = .Cells(Rows.Count, "B").End(xlUp).Row
.Range(.Cells(2, "C"), .Cells(END_ROW, "C")) = "=REPLACE(B2,FIND(""."",B2),0,IF(COUNTIF(B$2:B2,B2)>1,""(""&COUNTIF(B$2:B2,B2)-1&"")"",""""))"
.Columns("C:C").Copy
.Columns("B:B").PasteSpecial Paste:=xlPasteValues
.Columns("C:C").ClearContents
End With
End Sub
（ねむねむ） 2022/02/04(金) 13:36
セル範囲に式を入れるとフィルコピーした時のようにセル参照を変化させてくれる。 （ねむねむ） 2022/02/04(金) 13:38
ただ、以下の肝のコードはすごく長くて判りにくいので
解りやすいコードに分割出来ませんか？
（例えば、２－３行に分けるとか。。。）
.Range(.Cells(2, "C"), .Cells(END_ROW, "C")) = "=REPLACE(B2,FIND(""."",B2),0,IF(COUNTIF(B$2:B2,B2)>1,""(""&COUNTIF(B$2:B2,B2)-1&"")"",""""))"
それと、１行目は見出し行なので
そのまま実行するとB1の見出しが削除されてしまします。
（C列をB列に書き戻した後、B1も何処かに保持した文字列を書き出せば良いので困らないのですが
できればB1を残す方法のコードをお願いします。）
（山好き） 2022/02/04(金) 14:39
Sub TST()
Dim END_ROW As Integer
With Worksheets("Sheet1")
END_ROW = .Cells(Rows.Count, "B").End(xlUp).Row
.Range(.Cells(2, "C"), .Cells(END_ROW, "C")) = "=REPLACE(B2,FIND(""."",B2),0,IF(COUNTIF(B$2:B2,B2)>1,""(""&COUNTIF(B$2:B2,B2)-1&"")"",""""))"
.Range(.Cells(2, "C"), .Cells(END_ROW, "C")).Copy
.Range(.Cells(2, "B"), .Cells(END_ROW, "B")).PasteSpecial Paste:=xlPasteValues
.Columns("C:C").ClearContents
End With
End Sub
ではどうだろうか？
（ねむねむ） 2022/02/04(金) 14:46
あと、
.Range(.Cells(2, "C"), .Cells(END_ROW, "C"))
はC列2行目からC列のデータの最終行までを表し、そこに
"=REPLACE(B2,FIND(""."",B2),0,IF(COUNTIF(B$2:B2,B2)>1,""(""&COUNTIF(B$2:B2,B2)-1&"")"",""""))"
という式を入れるということなので分解しようがない。
あえて分解するとしたら文字変数に
"=REPLACE(B2,FIND(""."",B2),0,IF(COUNTIF(B$2:B2,B2)>1,""(""&COUNTIF(B$2:B2,B2)-1&"")"",""""))"
を代入して上記にその文字変数を入れるか。
（ねむねむ） 2022/02/04(金) 14:49
修正されたコードで見出し行を残せて上手くコピペ出来ました。
それにしても、肝の式が長いので
別のアプローチを考えないと見た目が難解で理解し難いです。
（山好き） 2022/02/04(金) 15:42
Dim dic As Object
Dim r As Range, v
Dim k As Long
Dim fn As String
Set dic = CreateObject("scripting.dictionary")
Set r = Range("B2", Cells(Rows.Count, 2).End(xlUp))
v = r.Value
For k = 1 To UBound(v)
If WorksheetFunction.CountIf(r, v(k, 1)) > 1 Then
fn = Split(v(k, 1), ".")(0)
dic(fn) = dic(fn) + 1
v(k, 1) = fn & "(" & dic(fn) & ").txt"
End If
Next
r.Value = v
End Sub
（マナ） 2022/02/04(金) 18:14
Sub test2()
Dim dic As Object
Dim r As Range, v
Dim k As Long
Dim fn As String
Set dic = CreateObject("scripting.dictionary")
Set r = Range("B2", Cells(Rows.Count, 2).End(xlUp))
r.Replace ".txt", "", xlPart
r.Replace "(*)", ""
v = r.Value
For k = 1 To UBound(v)
fn = v(k, 1)
If WorksheetFunction.CountIf(r, fn) > 1 Then
dic(fn) = dic(fn) + 1
v(k, 1) = fn & "(" & dic(fn) & ").txt"
Else
v(k, 1) = fn & ".txt"
End If
Next
r.Value = v
End Sub
（マナ） 2022/02/04(金) 18:37
Sub sample()
With Range("B2", Cells(Rows.Count, "B").End(xlUp))
buf = .Value
For i = 2 To UBound(buf)
n = WorksheetFunction.CountIf(.Cells(1, 1).Resize(i - 1), buf(i, 1))
If n > 0 Then
buf(i, 1) = Replace(buf(i, 1), ".txt", "(" & n & ").txt")
End If
Next
.Value = buf
End With
End Sub
（とおりすがり） 2022/02/04(金) 18:54
ねむねむさんの
"=REPLACE(B2,FIND(""."",B2),0,IF(COUNTIF(B$2:B2,B2)>1,""(""&COUNTIF(B$2:B2,B2)-1&"")"",""""))"
は、＝の前に”(クオート)が合るので分解することが出来ないのが推測されます。
式内では、、「.」が有るので拡張子を別途判断するので式が大変長くなっていると思います。
（＝の前に”が合っても上手く処理できる事自体、どんな原理なのかよく分かっていませんが.....）
そこでB列のTargetのファイル名を
D列：ファイル名だけ
E列：拡張子だけ
に分割しました。
Target ファイル名 拡張子 磐梯山.txt 磐梯山 txt
D列の（ファイル名だけ）をTargetにするとどうなりますか？
結果は、F列に書き出すとします。
（B列には、F列とE列を組み合わせた後で下記戻す予定です。）
マナさん、別次元の回答感謝します。
「CreateObject("scripting.dictionary")」なる聞き馴染みのないコードなので
調べるのにちょっと時間をください。
（山好き） 2022/02/04(金) 18:58
>＝の前に”が合っても上手く処理できる･･･ セルに数式を入れるには、RangeオブジェクトのFormulaプロパティに数式を ｢文字列｣で入れますが、｢文字列｣なので、Valueプロパティでも同じです >＝の前に”(クオート)が合るので分解することが出来ないのが推測されます ｢文字列｣なので&で結合すればいくらでも分割出来ます （どん） 2022/02/04(金) 19:30
コードをUPしていただきありがとうございます。
とても参考になるコードでどんな事をしているのか意味が判りやすいです。
どんさんへ
＞＞＝の前に”が合っても上手く処理できる･･･
＞セルに数式を入れるには、RangeオブジェクトのFormulaプロパティに数式を
＞文字列｣で入れますが、｢文字列｣なので、Valueプロパティでも同じです
すいません。
初心者には、意味が良く判りません。
もう少し、具体的に説明していただけませんか。
＞＞＝の前に”(クオート)が合るので分解することが出来ないのが推測されます
＞｢文字列｣なので&で結合すればいくらでも分割出来ます
「｢文字列｣なので&で結合すればいくらでも結合できます。」
ならば意味も通じるし理解も出来ますが
結合できたので分割してもコードが成立するかは別物と個人的には考えます。
（山好き） 2022/02/05(土) 07:03
以下は、連想配列の宣言だと言う事がネット情報で判りました。
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
最初からコードを追いかけていますが
以下が判りません。
Dim r As Range, v
最初は、以下のミス記載なのかなと思いました。
Dim r as Range,v as Range
なので以下のように書き換えてみましたが
当然、エラーが出てミス記載で無いのが理解できた次第です。
（素人有る有る）
Dim r as Range
Dim v as Range
後、以下のコードに続きますが今の私に難しすぎて以後のトレースは挫折しました。
r.Replace ".txt", "", xlPart
r.Replace "(*)", ""
v = r.Value
（ド素人） 2022/02/05(土) 08:19
長い数式を組み立てるのがわかりにくい」
というのが課題だとしたら
慣れないDictionaryを使っても解決になりません。
（とおりすがり）さんのコードを使用するとよいです。
（マナ） 2022/02/05(土) 09:17
Dictionaryは、素人には難しいので今は追いかけずに忘れる事にします。
（ド素人） 2022/02/05(土) 09:21
_____A________ 1 項目１ 2 磐梯山.txt 3 ホンダ.txt 4 越後駒ヶ岳.txt 5 赤城山.txt 6 ホンダ.txt 7 草津白根山.txt 8 ホンダ.txt 9 磐梯山.txt
■１
まず、とおりすがりさんのアドバイスで、その行までにA列の値が何個あるかは導き出せますよね
【作業列１】をC列とするならば、↓のような感じです
C2セル =COUNTIF($A$2:A2,A2)
■２
つぎに、「磐梯山.txt」という文字列から「磐梯山」を取り出すことを考えてみると、「.」が何文字目にあるか数えて、その1文字前まで取り出せばよさそうですね。
何文字目にあるのか調べる関数は、ねむねむさんが提示された数式が理解できているならわかりますよね。
「磐梯山.txt」の場合であれば、「.」は4文字目にあるのですから、左から3文字目（=4-1）までを取り出せばよいことがわかりますよね。左から○文字目までを取り出すにはLEFT関数を使います。
【作業列２】をＤ列とした場合は、上記を組み合わせて↓のようにすればＯＫです
D2セル =LEFT(A2,FIND(".",A2)-1)
■３
上記と同じ発想で、「磐梯山.txt」という文字列から「.txt」を取り出すには、○文字目以降を取り出せばよいですね。文字列の途中から取り出すにはMID関数を使います。
【作業列３】は一旦おいておき、Ｆ列を【作業列４】とした場合は、こんな感じです。
F2セル =MID(A2,FIND(".",A2),99)
※99のところは「.txt」が取り出せればいいので5以上の適当な数字をいれておきます。
■４
ここでC列に注目してみましょう。
1のとき → 何もつける必要はない = "" でＯk 2のとき → (1)にすればＯＫ 3のとき → (2)にすればＯＫ
↑のように1より大きい場合に C列の値-1を括弧を付けてあげればよいことに気づくはずです。
このように、条件分岐をするならばIF関数の出番です。
【作業列３】をＥ列とした場合はこんな感じです。
E2セル =IF(C2>1,"("&C2-1&")","")
■５
上記の数式を必要なだけ（フィル）コピーすると↓のようになるはずです。
_____A________ ______B_______ ___C___ ____D______ ___E___ ___F___ 1 項目１ 結果出力 作業列1 作業列2 作業列3 作業列4 2 磐梯山.txt 1 磐梯山 .txt 3 ホンダ.txt 1 ホンダ .txt 4 越後駒ヶ岳.txt 1 越後駒ヶ岳 .txt 5 赤城山.txt 1 赤城山 .txt 6 ホンダ.txt 2 ホンダ (1) .txt 7 草津白根山.txt 1 草津白根山 .txt 8 ホンダ.txt 3 ホンダ (2) .txt 9 磐梯山.txt 2 磐梯山 (1) .txt
ここまでできれば、話は単純です。
Ｄ～Ｆ列を合体させてＢ列に出力すればよいですね。
CONCATENATE関数やTEXTJOIN関数を使ってもよいですが、例えば↓のようにすればＢ列に結果が導き出せます。
B2セル =D2＆E2＆F2
そして、ほかの数式と同じように（フィル）コピーすればこうなります。
_____A________ ______B_______ ___C___ ____D______ ___E___ ___F___ 1 項目１ 結果出力 作業列1 作業列2 作業列3 作業列4 2 磐梯山.txt 磐梯山.txt 1 磐梯山 .txt 3 ホンダ.txt ホンダ.txt 1 ホンダ .txt 4 越後駒ヶ岳.txt 越後駒ヶ岳.txt 1 越後駒ヶ岳 .txt 5 赤城山.txt 赤城山.txt 1 赤城山 .txt 6 ホンダ.txt ホンダ(1).txt 2 ホンダ (1) .txt 7 草津白根山.txt 草津白根山.txt 1 草津白根山 .txt 8 ホンダ.txt ホンダ(2).txt 3 ホンダ (2) .txt 9 磐梯山.txt 磐梯山(3).txt 2 磐梯山 (1) .txt
■６
あとは、作業列を残したくないのであれば、B列をコピーしてからそのまま値貼付けして、C～F列を削除してしまえばよいですね。
■７
上記を整理つつコード化するとこんな感じになります。
Sub 研究用()
Dim 最終行 As Long
Stop 'ブレークポイントの代わり
With ActiveSheet
最終行 = .Cells(.Rows.Count, "A").End(xlUp).Row
If 最終行 > 1 Then
.Range("B2").Formula = "=D2&E2&F2"
.Range("C2").Formula = "=COUNTIF($A$2:A2,A2)"
.Range("D2").Formula = "=LEFT(A2,FIND(""."",A2)-1)"
.Range("E2").Formula = "=IF(C2>1,""(""&C2-1&"")"","""")"
.Range("F2").Formula = "=MID(A2,FIND(""."",A2),99)"
.Range("B2:F2").AutoFill Destination:=.Range("B2:F" & 最終行), Type:=xlFillDefault
.Range("B2:B" & 最終行).Value = .Range("B2:B" & 最終行).Value
.Range("C:F").Delete
End If
End With
End Sub
また、ねむねむさんのアドバイスのように、オートフィルではなくセル範囲に一気に数式を設定してしまうのも有効です。
Sub 研究用2()
Dim 最終行 As Long
Stop 'ブレークポイントの代わり
With ActiveSheet
最終行 = .Cells(.Rows.Count, "A").End(xlUp).Row
If 最終行 > 1 Then
.Range("B2:B" & 最終行).Formula = "=D2&E2&F2"
.Range("C2:C" & 最終行).Formula = "=COUNTIF($A$2:A2,A2)"
.Range("D2:D" & 最終行).Formula = "=LEFT(A2,FIND(""."",A2)-1)"
.Range("E2:E" & 最終行).Formula = "=IF(C2>1,""(""&C2-1&"")"","""")"
.Range("F2:F" & 最終行).Formula = "=MID(A2,FIND(""."",A2),99)"
.Range("B2:B" & 最終行).Value = .Range("B2:B" & 最終行).Value
.Range("C:F").Delete
End If
End With
End Sub
■余談1
同じ処理を何度やる予定かわかりませんが、一度っきりの作業だとしたら、わざわざマクロにする必要はないとおもいます。
■１～■６までの作業を手作業でやったってたかが知れてますよね？
いやいやVBAの勉強のためあえてコード化にトライするのだということであれば、まずは【ステップ実行】して提示されたコードを研究するところから始めてみるとよいと思います。
（もちろん、自分で書いたコードをステップ実行して検証することも重要です）
■余談２
＞初心者には、意味が良く判りません。
Range("B2") .Formula = "=D2&E2&F2"
B2セル の【数式】 は "=D2&E2&F2"
Range("B2") .Value = "=D2&E2&F2"
B2セル の【値】 は "=D2&E2&F2"
↑のように「Valueプロパティ」を使って書いても、"="で始まる文字列だった場合、Excel君が忖度してくれて数式として解釈してくれるけど、数式なんだから「Formulaプロパティ」を使うのが筋だという指摘だと思います。
■余談３
＞最初は、以下のミス記載なのかなと思いました。
Dim r As Range, v ↑を丁寧に書くと↓みたいになります。 Dim r As Range, v As Variant
例えば、↓のように書くと
v = Range("B2", Cells(Rows.Count, 2).End(xlUp)).Value
変数vに、Range("B2", Cells(Rows.Count, 2).End(xlUp))の値が【2次元配列】で格納されるわけですが、このような配列を受け取るためには、初めから大きさを決めた箱（静的配列）用意しておくか、データによって大きさが変わる箱（動的配列）を用意する必要があり、今回のケースでは、B列が何行あるのかわからないから、何でも型である「Variant」を指定しているのだとおもいます。
（もこな２） 2022/02/06(日) 13:29
ちょい補足。
■３
に関しては1文字目から○文字目(.の1文字前)までをを消してしまう(空文字に置き換える)、という考え方もできる。
その場合にはREPLACE関数が使える。
=REPLACE(A2,1,FIND(".",A2)-1,"")
（ねむねむ） 2022/02/07(月) 10:57
私は、以下のような
Range("B2") = "=D2&E2&F2"
"= で始まるコードを使ったことが有りません。
文字列で始まるコードがなぜ式（＝）になるか理解できなかったからです。
実際は、 Range("B2") .Formula と書くべきところを
..Formula が無くても
Excel君が忖度して数式として解釈してくれると言う事を初めて知りました。
セルに数式を入力/取得する(Formula/FormulaR1C1プロパティ)
セルに数式を入力、または入力されている数式を取得するプロパティです。
Formulaが使いこなせるレベルで無いので
いつものレベルのコードですが、
勉強のためモナコさんの「Sub 研究用()」のコードを
自分なりに理解しながらコードを書いてみました。
（以下の、Sub 研究用1_改造()）
出来たように思えたのに
If Cells(i, "C") > 1 Then
Cells(i, "E") = "(" & Str(hen) & ")"
で出力されるべき(1),(2)のような文字列が
なぜだか-1,-2のような数値になって出力されます。
これは、どうしてでしょうか？
str(hen)としているので文字列に変換されていると思ったのですが ？
Sub 研究用1_改造()
Dim i As Long
Dim Ws1 As Worksheet
Dim point As Integer
Dim hen As Integer
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(i, "C") = WorksheetFunction.CountIf(Range("A2", Cells(i, "A")), Cells(i, "A"))
point = WorksheetFunction.Find(".", Cells(i, "A"))
Cells(i, "D") = Left(Cells(i, "A"), point - 1)
hen = Cells(i, "C") - 1
If Cells(i, "C") > 1 Then
Cells(i, "E") = "(" & Str(hen) & ")"
Else
End If
Cells(i, "F") = Right(Cells(i, "A"), 4)
Cells(i, "B") = Cells(i, "D") & Cells(i, "E") & Cells(i, "F")
Next
'Range("C:F").Delete
End Sub
（山好き） 2022/02/07(月) 12:55
これは欧米ではマイナスの数値は(1)のようにカッコつきで表すことが多いため、EXCELでカッコつきの数値を入力すると マイナスの数値と判断される。 また、セルの表示形式が標準のセルに文字列で数字を入力してもEXCELの方でもともとの数値に変換してしまう。 なのでVBAでセルに文字列として数字を入力したい場合、セルの表示形式を文字列にしてから文字列にした数字を 入力することになる。 （ねむねむ） 2022/02/07(月) 13:09
>これは欧米ではマイナスの数値は(1)のようにカッコつきで表すことが多いため、EXCELでカッコつきの数値を入力すると >マイナスの数値と判断される。 これは手入力でセルにカッコつきの数字を入力することで確認できると思う。 （ねむねむ） 2022/02/07(月) 13:10
Excelの生まれが関わる理由で（１）が－１になるのですね。
E列の書式設定を「文字列」にすることで上手く(1)などが表示されました。
勉強のため、 Sub 研究用2()を試してみたいのですが
Sub 研究用2()は、Sub 研究用１()から以下を除いただけで
後は同じようです。
.Range("B2:F2").AutoFill Destination:=.Range("B2:F" & 最終行), Type:=xlFillDefault
コードが不足していると思われますが、違っていますか ？
（山好き） 2022/02/07(月) 14:34
研究用2は「オートフィルではなくセル範囲に一気に数式を設定」とあります
以下わかりやすく一部だけ抜粋しました
Sub 研究用1()
'B2セルに数式を入力
.Range("B2").Formula = "=D2&E2&F2"
'B2～F2の範囲を最終行までオートフィル（連続データの作成）
.Range("B2:F2").AutoFill Destination:=.Range("B2:F" & 最終行), Type:=xlFillDefault
Sub 研究用2()
'B2～最終行のセル範囲に数式を入力
.Range("B2:B" & 最終行).Formula = "=D2&E2&F2"
（横から補足） 2022/02/07(月) 14:54
違いが理解できました。
（山好き） 2022/02/07(月) 16:12
Cells(i,C")に書き出す場合はうまく処理できますが
Cells(i, "C") = hai_all(i)
Cells(i,"B")に直接書き出すと、当然上手く処理できません。
Cells(i, "B") = hai_all(i)
コードの下方のコメントアウトした部分は、「i」が１０になってしまうので
上手く処理できない。
’For ii = 2 To LRW
’Cells(ii, "B") = hai_all(i)
’Next
何か方法がありますか ？
Sub 一発()
Dim i As Long
Dim ii As Long
Dim Ws1 As Worksheet
Dim point As Integer
Dim Check As Integer
Dim m_hen As String
Dim LRW As Long
Dim hai_c() As String
Dim hai_d() As String
Dim hai_e() As String
Dim hai_f() As String
Dim hai_all() As String
Worksheets("Sheet1").Activate
LRW = Cells(Rows.Count, "B").End(xlUp).Row
ReDim hai_c(LRW)
ReDim hai_d(LRW)
ReDim hai_e(LRW)
ReDim hai_f(LRW)
ReDim hai_all(LRW)
For i = 2 To LRW
'その行までにA列と同じ値があるか？
hai_c(i) = WorksheetFunction.CountIf(Range("B2", Cells(i, "B")), Cells(i, "B"))
'文字列中の"."の位置を求める
point = WorksheetFunction.Find(".", Cells(i, "B"))
'拡張子以外の文字列を抽出
hai_d(i) = Left(Cells(i, "B"), point - 1)
'1より大きい場合に C列の値に括弧を付ける
Check = hai_c(i) - 1
If Check >= 1 Then
'Excelの生まれが関わる理由で（１）は、そのままでは「－１」になるので
'E列の書式設定を「文字列」にすることで上手く(1)などが表示される。
hai_e(i) = "(" & Str(Check) & ")"
Else
End If
'拡張子部分を抽出
hai_f(i) = Right(Cells(i, "B"), 4)
hai_all(i) = hai_d(i) & hai_e(i) & hai_f(i)
Cells(i, "C") = hai_all(i)
Next
’For ii = 2 To LRW
’Cells(ii, "B") = hai_all(i)
’Next
End Sub
（山好き） 2022/02/07(月) 17:25
＞For i = 2 To LRW → For i=LRW to 3 Step -1
配列にする必要もありません。
（ひまつぶし） 2022/02/07(月) 17:54
なるほど、最後の行から処理していけば上手く（番号）が添付されるのを確認しました。
的確なアドバイス、感謝します。
今回は、作業セルを使いたくなかったので
私の考えうるレベルで配列を利用してで処理しました。
＞配列にする必要もありません。
＞なにか不満がおありですか？
とうりすがりさんのコードに不満が有るわけでは無いです。
達人さんは、スキルが有るのでその必要のない方法もいくつか思い浮かぶでしょうが
初心者レベルの私にはそのスキルが無いので勉強中です。
（山好き） 2022/02/07(月) 18:38
18：54がとおりすがりさんが考えた
配列を利用したコード（計算方法）で有ることは理解しています。
それが、以下に相当します。
＞達人さんは、スキルが有るのでその必要のない方法もいくつか思い浮かぶでしょう
最初、実務ではとおりすがりさんの18：54のコードをそのまま利用させて頂きましたが
もなこ２さんが別の回答（Sub 研究用())をしてくださったので
自分なりにレベル向上のためSub 研究用()を今の私のレベルで
配列版に改造して見た訳です。
拙いコードで達人さんは、「何と無駄な、何やってんだ？」のレベルなので
誤解を招くような回答が続いたことお詫びいたします。
それが以下に相当します。
＞初心者レベルの私にはそのスキルが無いので勉強中です。
（山好き） 2022/02/08(火) 03:48
hai_all(i) = hai_d(i) & hai_e(i) & hai_f(i)
'Cells(i, "C") = hai_all(i) ' 不要なので削除
Next
For ii = 2 To LRW ' ループ変数は i でも ii でもよいですが
Cells(ii, "B") = hai_all(ii) ' Cells(●,"B")とhai_all(●)の●は同じでないといけないです
Next
End Sub
（とおりすがり） 2022/02/08(火) 06:32
ご参考。
Sub Sample()
Dim r As Long, c As Long, n As Long
Dim s As String
For r = Cells(Rows.Count, "B").End(xlUp).Row To 3 Step -1
s = Cells(r, "B")
c = WorksheetFunction.CountIf(Range("B2:B" & r - 1), s)
If c > 0 Then
n = InStrRev(s, ".")
Cells(r, "B") = Left(s, n - 1) & "(" & c & ")" & Mid(s, n)
End If
Next
End Sub
（ひまつぶし） 2022/02/08(火) 08:06
考えると色んな方法が見えてくるものですね。
（山好き） 2022/02/08(火) 16:41
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.