Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 8.1 Pro : Excel 2010)
回数を1つ増やす
投稿日時: 19/01/06 17:21:43
投稿者: tako552101

お世話になります。
 
開催日、イベント名、会場、ほか備考など記載した日程表を毎年作成しております。
ほぼ手入力で、イベントには「第●回 ビンゴ大会」など回数が記載されているものがあり、昨年のものをコピペして回数を1つ増やす作業をコツコツおこなっているのですが、行が多くてしかも目視なので間違いも生じやすく、毎年のことなので自動化できないかお知恵をお借りしたく投稿させていただきました。
 
よろしくお願いします。

回答
投稿日時: 19/01/06 19:29:39
投稿者: WinArrow
投稿者のウェブサイトに移動

#コードの作成依頼ですか?
この板では、
コードの作成依頼は、禁止されています。
 
 
文章だけの質問なので、
文章だけで回答します。
 
回数が入っているセルの値に「1」を加算して
元のセルに代入すればよいでしょう。
 
ヒント
例、セルA1
 
Range("A1").Value = Range("A1").Value + 1
 
 
 

回答
投稿日時: 19/01/06 19:37:43
投稿者: WinArrow
投稿者のウェブサイトに移動

VBAでなくても、一般機能で十分対応できると思います
  

セルA1に「1」を入力します。
  
現在回数が入っているセル範囲を「D1〜D20」と仮定します。
  
セルA1を選択して「コピー」
セルD1〜D20を選択し、
 「形式を選択して貼り付け」→ダイアログで「加算」を選択して「OK」
  
セルをひとつづつ手修正するより、早いと思います。
 

回答
投稿日時: 19/01/06 23:37:35
投稿者: simple

もうすこし例をたくさん挙げればどうでしょうか。
単に数値のはいったセルというよりも、文字列の置換の話だと思うのですが、
どこに苦労しているのか伝わりにくくなっていると思います。
 
    A列

引用:
1 第1回大会
2 第二回集会
3 第3回定期大会
4 第 5回大会第3部会
などと色々なパターンがあって、それを判断しながら手作業でcount upしています、
というようなことなんでしょうか。

投稿日時: 19/01/07 03:33:09
投稿者: tako552101

みなさん、ありがとうございます。
知恵を借りたい → 作成依頼 先生厳しい〜
 
回数は別セルではなくイベント名セルに入ってしまっているので厄介なんです。
 
イベント名セルは複数シートのC3から最大C70位まで(シートによってマチマチ)入力されていて、セルによってはセル内で改行されています。この中に入力されている「第XX回」(XX=1〜3桁の数字)の数値のみを1つ増やしたいのです。
例:「第35回 ビンゴ大会」→「第36回 ビンゴ大会」 「第100回 映画鑑賞会」→「第101回 映画鑑賞会」
これ以外にも「第1次」「第五戦」などの入力はありますが、あくまで対象は「第XX回」のみです。
 
「第XX回」は多くても100位なのでこの際全てを置換してしまえばと、…

Sub Sample2()
    Range("F7:C50").Replace "第100回", "第101回", xlPart
    Range("F7:C50").Replace "第99回", "第100回", xlPart
・
・
・
    Range("F7:C50").Replace "第2回", "第3回", xlPart
    Range("F7:C50").Replace "第1回", "第2回", xlPart
End Sub
のようなテストをしてみましたがうまくいきません。おそらく条件に合わない場合にマクロが止まってしまう。
=MID(C3,FIND("第",C3),FIND("回",C3)-FIND("第",C3)+1)
のような計算式で取り出そうにも、1つ目はうまくいっても、2つ目以降は、セル内改行で1行目に「第1次」「第30回」、2行目に「第一次」「第30回」など同じ回数や置換しなくてもいい「第1次」「第一次」が邪魔してうまくいかない。うーん、
 
ヒントでもいただければと思います。

回答
投稿日時: 19/01/07 09:52:16
投稿者: WinArrow
投稿者のウェブサイトに移動

>例:「第35回 ビンゴ大会」→「第36回 ビンゴ大会」 「第100回 映画鑑賞会」→「第101回 映画鑑賞会」
 
この例は、1つのセルのこのような「値」が入力されているのでしょうか?
これと
>Range("F7:C50").
のようなセル範囲の関係が、イメージできないのですが・・・・
 
置換で対応するのは、しんどいでは?
 
私だったら
たとえば、
 
セルA1
「値」
「表示英式」で"第"0"回 ビンゴ大会"のように設定しておけば
Range("A1").value = Range("A1").Value + 1
で対応できるし、見た目は、「第10回 ビンゴ大会」のように表示できます。
 

投稿日時: 19/01/07 11:53:51
投稿者: tako552101

セル範囲間違ってました。すみません。イベント名はC列のみですので、C3:C50です。
 
C3=
第35回 ビンゴ大会
第100回 映画鑑賞会
ゲートボール大会第1戦
第100回 大抽選会
 
C4=
第35回 ビンゴ大会
兼 第35回 北海道ビンゴ大会第1次予選



のようにセル内で改行して入力されています。
改行がないセルもあります。最大6行です。
 
よろしくお願いします。

回答
投稿日時: 19/01/07 12:04:16
投稿者: Suzu

引用:
「第XX回」は多くても100位なのでこの際全てを置換してしまえばと、…
Sub Sample2()
    Range("F7:C50").Replace "第100回", "第101回", xlPart
    Range("F7:C50").Replace "第99回", "第100回", xlPart



    Range("F7:C50").Replace "第2回", "第3回", xlPart
    Range("F7:C50").Replace "第1回", "第2回", xlPart
End Sub
のようなテストをしてみましたがうまくいきません。おそらく条件に合わない場合にマクロが止まってしまう。

 
上手くいかないと言うのは?具体的なにが希望と違うのでしょうか?
 
On Error Resume Next
をいれても一緒?
 
私なら、たぶん、Replaceは使わずに
For Each で対象セルに対し Like "*第*回*" を 条件に走査し 中の数値を + しますかね。

回答
投稿日時: 19/01/07 14:24:39
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:
C3=
第35回 ビンゴ大会
 第100回 映画鑑賞会
ゲートボール大会第1戦
 第100回 大抽選会
  
C4=
第35回 ビンゴ大会
 兼 第35回 北海道ビンゴ大会第1次予選

 
この例では、「第XX回」以外もあるようですが、
全てに対応する必要があるんですか?
 
「第2回」と「第二回」は違いますよね?
半角数字と全角数字も違いますよね?
「第1戦」は対応する?が「第1次予選」は対応しない?・・かな?
 
全てのパターンをコード化するのには、しんどくないですか?
文字列の中から「数字」部分を抜き出し、計算後、文字列を組み立てるようなことを考えたらいかがでしょう?
それに対応するにも、数字の前後の文字列(または、次の文字列)を
規定(複数あってもよい)することになりますが・・・
 
 
 

回答
投稿日時: 19/01/07 15:37:17
投稿者: Suzu

引用:
上手くいかないと言うのは?具体的なにが希望と違うのでしょうか?
  
On Error Resume Next
をいれても一緒?

 
逆だ。。
・On Error 〜〜 を外して、目的通りにならない理由を探す。
・変換にならないセルだけを対象に、置換処理を行い、置換されない原因を探る。
 
置換(Replace)ができるのであれば、
 
Sub Sample2()
  Dim i As Long
 
  For i = 100 To 1 Step -1
    Range("C3:C50").Replace "第" & i & "回", "第" & i + 1 & "回", xlPart
  Next i
End Sub
 
で済む話ですよね。
 
マクロにしたら、更新したかどうか判らなくなるのを防ぐのに、
更新日をフィールドとして持たせるとか。。
 
自動化とか、管理のし易さを考慮するなら
・第●回 の部分を別フィールドに持たせる
・セル内で改行を止めて独立レコードにする
等を考慮すべきでしょう。

投稿日時: 19/01/07 19:23:48
投稿者: tako552101

Suzuさん、ありがとうございます。
 
うまくいかないと言ったのは、エラーという事ではなくReplaceを連続で行った場合、検索結果が該当なしの場合に次の検索を行ってくれない、という事です。たぶん...
ですので、1番最初の「第100回」の該当がない場合は次の「第99回」は置換もされない...
 
なので、素人ながら第XX回を検索して、該当があればReplaceという感じで...

Sub test()
Dim c As Variant
Dim i As Long

For Each c In Range("C3:C50")
    For i = 100 To 1 Step -1
        If InStr(c.Value, "第" & i & "回") > 0 Then
            c.Replace "第" & i & "回", "第" & i + 1 & "回", xlPart
        End If
    Next i
Next c
End Sub
全てをチェックしたわけではないのですが、うまく行ってそうな気配。
 
作業列を作ってFINDのネストで検索して、MIDで抽出、とかいろいろいじくりまわしましたが、エラー回避が大変で躊躇してました。この方がスッキリ置換されるようですが、落とし穴などご指導いただければと思います。

回答
投稿日時: 19/01/07 19:37:57
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:
For Each c In Range("C3:C50")
    For i = 100 To 1 Step -1
        If InStr(c.Value, "第" & i & "回") > 0 Then
            c.Replace "第" & i & "回", "第" & i + 1 & "回", xlPart
        End If
    Next i
Next c

は、無駄が多い。
 
 
Suzu さん、レスの
Sub Sample2() 
   Dim i As Long 
  
   For i = 100 To 1 Step -1 
     Range("C3:C50").Replace "第" & i & "回", "第" & i + 1 & "回", xlPart 
   Next i 
 End Sub
をお勧めします。

回答
投稿日時: 19/01/07 20:36:35
投稿者: simple

> 検索結果が該当なしの場合に次の検索を行ってくれない、という事です。
そういうこと(つまり2つが関係しあっていること)はないはずです。
別の要因だと思います。
 
(1)数値の前後にスペースが入っていたりしませんか?
 
(2)全角半角の違いはどうですか?
   というのは、Replaceメソッドの引数で省略したものは、
   直近の動作を踏襲するのが決まりです。(検索 Findも同じです)
   「半角と全角を区別する」で検索なり置換をしたあとですと、
   全角にマッチしないことがありえます。
   ですから、すべての引数を省略せずに指定するのがよいでしょう。
 
以上のようなことが気になりました。
 
ところで、別のコードを書いてみたいと思いますので、
それまで閉じるのを待って貰えませんか?

回答
投稿日時: 19/01/07 21:22:29
投稿者: simple

バックアップをとってから試してみてください。
 

Sub test()
    Dim r           As Range
    Dim s           As String
    Dim Matches     As Object
    Dim m           As Object
    Dim matchStr    As String
    Dim matchStr2   As String
    Dim replaceStr  As String
    Dim k           As Long
    Dim i           As Long

    With CreateObject("VBScript.RegExp")
        .Pattern = "(第\s*([\d0-9]+)\s*回)"
        .Global = True
        
        ''   For Each r In Selection
        For Each r In Range("C3:C50")
            s = r.Value
            Set Matches = .Execute(s)

            For k = Matches.Count - 1 To 0 Step -1
                Set m = Matches.Item(k)
                matchStr = m.Value
                matchStr2 = m.SubMatches(1) '回数の文字列
                i = m.FirstIndex

                replaceStr = myReplace(matchStr2) 'count upした回数

                s = Left(s, i) _
                     & Replace(s, matchStr2, replaceStr, i + 1, 1)
                'うしろから置換することで文字位置のずれの影響を回避     

            Next
            r.Value = s
        Next
    End With
End Sub

Function myReplace(s As String) As String
    '(1)半角で統一するなら
    'myReplace = CInt(s) + 1

    '(2)全角は全角で、半角は半角のままにしたいなら以下
    If s = StrConv(s, vbNarrow) Then
        myReplace = CInt(s) + 1
    Else
        myReplace = StrConv(CInt(s) + 1, vbWide)
    End If
End Function

 
正規表現というものを使っています。あくまで参考の別解です。
鶏頭を割くに牛刀をもってす、の類の話ですね。

投稿日時: 19/01/08 00:59:53
投稿者: tako552101

みなさん、ありがとうございます。
 
Suzuさんご指定のコードのままで動作していればよかったのですが、素人ながらの苦肉の策でした。
残念ながら私のスキルでは原因は突き止められませんが、どこかのサイトに書いてあったような気がして、一旦検索をかけてから、実行する1ステップを入れた所、動くようになりました。
 
「第XX回」のXXは1〜3桁の数値でこれのみ置換対象です。ですので「第一次」「第1戦」などは置換対象外となります。また、全角はありませんし半角スペースもありません。
 
simpleさんのコードは難しくて理解するのに時間がかかりそうですが、わざわざご提示いただき感謝に堪えません。ありがとうございます。

回答
投稿日時: 19/01/08 07:24:37
投稿者: simple

tako552101 さんの引用:
また、全角はありませんし半角スペースもありません。

そうでしたか、残念。
では、手作業で、すべて置換ではなく、1つ1つ置換して、
なぜ置換されるはずのところが置換されないか、よく調べるとよいと思います。
なんらかの原因があるはずです。
それを調べられるのは質問者さんしかいません。
 
>simpleさんのコードは難しくて理解するのに時間がかかりそうですが、わざわざご提示いただき感謝に堪えません。ありがとうございます。
わざわざありがとうございます。
閲覧されているかたにも向けた発信ですので、どうぞお気遣い無く。

回答
投稿日時: 19/01/08 09:55:27
投稿者: Suzu

引用:
一旦検索をかけてから、実行する1ステップを入れた所、動くようになりました。

 
との事ですので、
 
まさしく
引用:
「半角と全角を区別する」で検索なり置換をしたあとですと、
   全角にマッチしないことがありえます。
   ですから、すべての引数を省略せずに指定するのがよいでしょう。

が対策でしょう。
 
Range("C3:C50").Replace "第" & i & "回", "第" & i + 1 & "回", xlPart
     ↓
Range("C3:C50").Replace "第" & i & "回", "第" & i + 1 & "回", xlPart, xlByRows, False, True
 
の様に、SearchOrder、MatchCase、MatchByte の引数まで指定しましょう。

投稿日時: 19/01/08 17:55:17
投稿者: tako552101

みなさん、ありがとうございました。
 
実はあれからSuzuさんのコードを再度試してみたらちゃんと動きました。不思議です。

引用:
「半角と全角を区別する」で検索なり置換をしたあとですと、
   全角にマッチしないことがありえます。

 
これが起因していたのかもしれません。修正済みです。
 
本当にありがとうございました。