[[20230320110726]] 『一度使われた番号をリスト表示させたくない』(兎年) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『一度使われた番号をリスト表示させたくない』(兎年)

いつも大変参考にさせて頂いております。
似たような質問が見つからなかったので質問させてください。

エクセル上で見積の番号取得をしたいのですが

(Sheet1)
   A
1  0001
2  0002
3  0003
4  0004
   〜 9999まで続く

(sheet2)・・・A1は(sheet1よりリスト表示)
   A       B           C
1  0001  〇〇マンション新築工事   実行ボタン

shhet2は単純に番号を取得するだけのシートとし、0001を取得(使用)したら使用済みという事で、もうリストには出てこない様にしたいのですが、そんな事可能でしょうか。

(未来の話でC1あたりにA1とB1の文字を利用しフォルダを作成する実行ボタンを作成する予定ですがまだそこまで行けないのでココでは割愛させて頂きます。)

< 使用 Excel:Excel2016、使用 OS:Windows11 >


 使用済みか、そうでないかはどのように判断しますか?
(稲葉) 2023/03/20(月) 11:26:31

稲葉さま、ありがとうございます。

このエクセルは常時5人くらいからのランダムなアクセスになる予定です。
Aさんが開いているときは別の人(BCDEさん達)は読み取り専用

そうなんです・・・最初私が思ったのは

Aさんが開いて

(Sheet1)
   A   B   C
1  0001 0001  0 
2  0002    0002
3  0003    0003
4  0004    0004
   〜 9999まで続く

(sheet2)・・・A1は(sheet1のC列よりリスト表示)
   A       B           C
1  0001  〇〇マンション新築工事   実行ボタン

sheet2のリスト表示はsheet1のC列より表示させる
sheet2のB1に何か入力されたら
sheet1のB1にA1と同じ数字が表示されて
sheet1のC1にA1-B1の結果が表示される

Aさんが保存して閉じる
次にBさんが開いて(sheet2)A1には0002から表示される みたいな感じです

これだと使用したかしてないかは可能かな?と
ただ考えがあまりにも安易でsheet1のB1とC1の関数が分からなくなってしまいました。

行き詰っております・・・

ご教授頂ければ幸いです。
(意味不明だったらごめんなさい)

(兎年) 2023/03/20(月) 12:14:00


 うん、意味が分からない。

 要件まとめると
 見積Noの採番を行いたい。
 見積Noは連番で行いたい。
 見積書の番号は一意の値にしたい。

 ここまではわかったけど、Sheet2とSheet1の関係が分かってない。
 >shhet2は単純に番号を取得するだけのシートとし、0001を取得(使用)したら使用済みという事で、もうリストには出てこない様にしたい
 これが何のためなのかわからない。

 連番に拘らないで、日時-顧客コード-担当コード-見積もり発行回数みたいにしておいて
 202303201350-A0012-Z089-001
 こんな感じで見積Noを作って、1列に追加していけばいいだけだと思うのですが・・・

 そうすればリストもいらないのでは?

 どうしても連番が必要なら、Sheet1のA列は何も入力せずに
 Sheet2!A1=TEXT(Sheet1!COUNT(A:A),"0000")
 としておいて、採番したらコピーしてSheet1のA列最終行に貼り付けすれば、
 勝手に連番になるし、リストも必要ない。

(稲葉) 2023/03/20(月) 14:01:35


 >『一度使われた番号をリスト表示させたくない』 

 参考

 Sheet1
     |[A]|[B]     
 [1] |   |使用済み
 [2] |  2|        
 [3] |   |使用済み
 [4] |  4|        
 [5] |   |使用済み
 [6] |  6|        
 [7] |   |使用済み
 [8] |  8|        
 [9] |   |使用済み
 [10]| 10|        
 B1=IF(COUNTIF(Sheet2!$A$1:$A$10,Sheet1!$A1)=1,"使用済み","")
 B1セル右下ダブルクリック
 条件付き書式
  A1:A10を選択して
   数式を使用して
  「=COUNTIF(Sheet2!$A$1:$A$10,$A1)=1」
   書式
   ユーザー定義「;;;」

 Sheet2
    |[A]|[B]
 [1]|  1|AAA
 [2]|  3|BBB
 [3]|  5|CCC
 [4]|  7|DDD
 [5]|  9|EEE
(ふめい) 2023/03/20(月) 14:42:37

稲葉さま
ですよね、スミマセン・・・

>shhet2は単純に番号を取得するだけのシートとし、0001を取得(使用)したら使用済みという事で、もうリストには出てこない様にしたい

 これが何のためなのかわからない。

→sheet2に表示されている番号と件名を使用し、指定した場所に新規フォルダを作りたいのです。

(sheet2)・・・A1は(sheet1のC列よりリスト表示)
   A       B
1  0001  〇〇マンション新築工事

これを手作業で行うと
ファイル→名前を付けて保存→\場所を指定\→新しいフォルダー→「0001 〇〇マンション新築工事」
というフォルダが作成されるようになりたいのです。

sheet1に連番でとるのも良いのですが、そうなると最終的にフォルダを作りたいという作業が不可能なのかな?といった素人考えです。

(兎年) 2023/03/20(月) 15:30:42


 >〜 9999まで続く
 0001から順番に取得するんですか。
 それともランダムですか。

(ふめい) 2023/03/20(月) 15:40:17


ふめいさん
ありがとうございます。

単純に順番に取得していきます。

Aさんが開く0001を取得し保存・閉じる
Eさんが開く0002を取得し保存・閉じる
Bさんが開く0003を取得し保存・閉じる
(兎年) 2023/03/20(月) 15:57:12


 いや、フォルダ作るのはとても簡単です。
 以下のコードはデスクトップの10000個のフォルダ作るコードです。
 fpの部分を「202303201350-A0012-Z089-001」
 とかで指定すれば作れるので、リストで連番作るよりよっぽどコーディングしやすいです。

    Sub フォルダを作る()
        Dim i As Long
        Dim fp As String
        fp = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\フォルダ作成テスト"
        MkDir fp
        fp = fp & "\"
        For i = 0 To 9999
            MkDir fp & Format$(i, "0000")
        Next i
        MsgBox "デスクトップのフォルダを作成しました"
        CreateObject("WScript.Shell").Run fp
    End Sub

 聞いた限り、見積1つにつき、1ブック使う感じですか?
 特定のフォーマットにデータだけ落とし込んで使うとかではないんですか?
(稲葉) 2023/03/20(月) 17:50:52

稲葉さま

すごく、びっくりしました!!!
いただいたコードを実行させたらできました。
すみません、私の知識が低すぎるもので・・・
ちょっと休みの日にいろいろ試してみたいと思います。
ご連絡遅くなるかもしれませんが、もう少しお付き合い頂ければ幸いです。

(兎年) 2023/03/20(月) 18:56:02


稲葉さま

稲葉さんに先日いただいたコード以外の実行ができませんでした。
まず、そもそも理解していないというのが一番の原因ですが・・・
ダメな生徒でごめんなさい。

例えばですが、以下の様な場合だとどうでしょうか?

(Sheet1)
   A    B     
1  番号  件名   
2  0001  〇〇工事
3  0002  △△工事
4  0003  
5  0004
6  0005

 〜 9999までは固定で最初から番号が入力されている

以前にも説明させて頂きましたが
このエクセルは常時5人くらいからのランダムなアクセスになる予定です。
Aさんが開いているときは別の人(BCDEさん達)は読み取り専用

例えばAさんが開いてB3=△△工事を入力したとします。
この時にフォームコントロールボタンにて「0002 △△工事」とうフォルダを作成するようにしたのです。その後は保存→閉じるにてAさんは終了。
次にDさんが開いた時、B4に新規工事名を入力して上記同じく「0003 新規工事名」というフォルダが作成される。

こういった流れが理想でした。

扱う5人(ABCDEさん達)の中には60代後半の方もいるため、業務効率アップと間違い防止も含めてこういったのがあったら良いなという思いから質問させて頂きました。

その出来たフォルダの中には、自分達でPDFや図面データを入れたりしていこうと思っていました。

上手く伝わったかわかりません、そしてそれが出来るのかも私には未知の世界ですが、もし可能であればお付き合い頂ければ大変うれしく思います。

(兎年) 2023/03/22(水) 17:08:30


 こんな感じでどうですか?

 1)新しいブックを作り、任意の場所に保管してください
 2)以下のコードを標準モジュールに入れてください。
 3)Const myPassWord As String = "1234"
   の"1234"部分を、任意のパスワードに変更してください
 4)mkSheetLayout を1回だけ実行して、テスト環境を整えてください。
 5)4)で作成したシートの、B2セルに、フォルダを作っていきたいアドレスを入力してください。
 6)B列に案件名を入力してください
 7)DirectoryMaking() を実行すると、案件名が入力されているセルを検出し、
   0001_案件名のフォルダを作成し、ファイルを保存する
 8)ただし、すでに存在する連番かどうかは判断しない。
   例
   連番   案件名 
   0001   abc   と入力があった場合、すでに指定フォルダに「0001_XYZ」があっても、
   存在チェックしないで0001_abcフォルダを作成する
    '//コード ここから
    Option Explicit

    Const myPassWord As String = "1234"
    '//シートレイアウトを作成するマクロ 一回だけ実行する。実行後は削除してもOK
    Sub mkSheetLayout()
        If MsgBox("このマクロの実行は一回だけにしてください", vbOKCancel) <> vbOK Then
            Exit Sub
        End If
        With Sheets(1)
            .[A:A].NumberFormatLocal = "@"
            .[A2].Value = "親フォルダ"
            With .[B2]
                .Value = "C:\テスト\"
                .Locked = False
            End With
            .[C2].Formula = "=IF(RIGHT(B2)<>""\"",""最後に \ をつけてください"",""OK"")"
            .[A6:D6].Value = [{"連番","案件名","作成済フラグ","リンク"}]
            .[A7:A10005].Value = [=if(row(1:9999),text(row(1:9999),"0000"))]
            .[D7:D10005].Formula = "=IF(COUNTIF(C7,""*作成*"")=0,"""",HYPERLINK($B$2&A7&""_""&B7,""フォルダリンク""))"
            With .[B7:B10005]
                .Locked = False
                .Interior.Color = rgbAliceBlue
            End With
            .Protect Password:=myPassWord, userinterfaceonly:=True
        End With
        MsgBox "シートレイアウトを生成しました。"
    End Sub

    '//フォルダを作成するマクロ。案件名を入力し実行すると、フォルダを作成して案件名を編集できないようにロックを掛ける
    Sub DirectoryMaking()
        Dim tbl As Variant
        Dim i As Long
        Dim BASErng As Range
        Dim fp As String
        Dim mkfp As String
        If ThisWorkbook.ReadOnly = True Then
            MsgBox "読み取り専用で開かれています。処理を中断します"
            Exit Sub
        End If
        If MsgBox("プログラムを実行すると、フォルダを自動作成し、ブックは上書き保存されます。よろしいですか?", vbYesNo) <> vbYes Then
            Exit Sub
        End If
        With Sheets(1)
            '初期設定
            Set BASErng = .Range("A7")
            fp = .[B2].Value
            If Right(fp, 1) <> "\" Then fp = fp & "\"
            If Dir(fp, vbDirectory) = "" Then
                MsgBox fp & "フォルダーは存在しません。手動で作成してから再度実行してください"
                Exit Sub
            End If

            'A:C列のデータを取得する
            tbl = .Range(BASErng, .Cells(Rows.Count, "B").End(xlUp)).Resize(, 3).Value
            For i = 1 To UBound(tbl, 1)
                '案件名が空白以外で、作成済フラグが空白の場合、フォルダを作成する
                If tbl(i, 2) <> "" And (Not tbl(i, 3) Like "*作成*") Then

                    'フォルダパスの生成
                    mkfp = fp & tbl(i, 1) & "_" & tbl(i, 2)

                    'エラー処理
                    Select Case True
                        'フォルダ名に使えない文字が含まれていた場合
                        Case FileNameChk(tbl(i, 2)) = False
                            tbl(i, 3) = "フォルダ名に\/:*?""<>|を含む文字は使えません"

                        'すでにフォルダが存在するかチェックし、存在しなければ作成する。
                        Case Dir(mkfp, vbDirectory) = ""
                            MkDir mkfp
                            tbl(i, 3) = Format$(Date, "yymmdd作成")

                            '作成したフォルダを変更できないように、案件名をロックする
                            BASErng.Offset(i - 1, 1).Locked = True

                        'フォルダが存在したら、作成済みフラグを埋める
                        Case Else
                            tbl(i, 3) = "作成済でした"
                            '作成したフォルダを変更できないように、案件名をロックする
                            BASErng.Offset(i - 1, 1).Locked = True
                    End Select
                End If
            Next i
            'シートの保護を解除して、マクロからだけ書き込めるように変更
            .Protect Password:=myPassWord, userinterfaceonly:=True
            .Range("A7").Resize(UBound(tbl, 1), UBound(tbl, 2)).Value = tbl
        End With
        '上書き保存
        ThisWorkbook.Save
        MsgBox "フォルダを作成しました。確認して下さい"
    End Sub

    '//案件名がフォルダ名に使えるかチェックするサブプロシジャ
    Private Function FileNameChk(ByVal s As String) As Boolean
        'ファイル名に使えるかチェックする
        With CreateObject("VBScript.RegEXP")
            .Global = True
            .Pattern = "[\\/:*?""<>|]"
            FileNameChk = Not .test(s)
        End With
    End Function
    '//コード ここまで
 実行結果例
     |[A]       |[B]       |[C]                                        |[D]           
 [1] |          |          |                                           |              
 [2] |親フォルダ|C:\テスト\|OK                                         |              
 [3] |          |          |                                           |              
 [4] |          |          |                                           |              
 [5] |          |          |                                           |              
 [6] |連番      |案件名    |作成済フラグ                               |リンク        
 [7] |      0001|〇〇工事  |230322作成                                 |フォルダリンク
 [8] |      0002|△△工事  |作成済でした                               |フォルダリンク
 [9] |      0003|abc:      |フォルダ名に\/:*?"<>|を含む文字は使えません|              
 [10]|      0004|          |                                           |              
 [11]|      0005|          |                                           |              
 [12]|      0006|          |                                           |              

(稲葉) 2023/03/22(水) 19:29:27


稲葉さま

すみません、本当にごめんなさい
(2)(3)で挫けています・・・

Bookはxlsm形式で良かったですか?
開発→VisualBasic→挿入→標準モジュール→Module1に「Const myPassWord As String = "1234"」を書き込む

この工程で合っていますか?
(兎年) 2023/03/23(木) 11:25:07


2で言う「以下のコード」は
Option〜以降のことですよ。
(おじ) 2023/03/23(木) 12:11:18

 おじさんフォローありがとうございます。

 兎年さん
 >Bookはxlsm形式で良かったですか?
 xlsmが適当かと思います。

 >開発→VisualBasic→挿入→標準モジュール→Module1に「Const myPassWord As String = "1234"」を書き込む
 すでに案内があった通りですが、先ほどもう少しわかりやすくしました。

 '//コード ここから
 〜〜
 '//コード ここまで
 全部標準モジュールに貼り付けてください。

 ちなみにAlt+F11でVBE開くので便利ですよ。
(稲葉) 2023/03/23(木) 12:23:13

おじさま、稲葉さま

優しく教えて頂き涙が出そうです。

Alt+F11 感動しました( ノД`)

でも挫折は続いています。ごめんなさい。

Module1を開くと

(General)               (Declarations)

 Option Explicit

とあります。

この
Option Explicit の部分を
Option Const myPassWord As String = "1234" とすれば良いのでしょうか?

その後に

 '//コード ここから
 〜〜
 '//コード ここまで
これを書き込む?

ん???
(兎年) 2023/03/23(木) 12:39:29


 >Option Explicit
 は一度消してください。

 >>その後に
 >>'//コード ここから
 >>〜〜
 >>'//コード ここまで
 >これを書き込む?

 >(稲葉) 2023/03/22(水) 19:29:27
 の投稿を変更して、コードの前後に上記の文言追加したので見てください。
(稲葉) 2023/03/23(木) 12:47:21

稲葉さま

ごめんなさい、やっと理解しました!
そして文言追加の把握をしておりませんでした。
反省です。スミマセン。。。

保存して実行してみました。
マクロの画面が出てきて
マクロ名のところに「DirectoryMaking」となっていたのでそのまま「実行(R)」をクリックしてみました。

稲葉さまが作成してくれたメッセージが出てきて、「はい」で進むと最後に「フォルダを作成しました。確認してください」まで行きました。

なんだかすごすぎて質問が出てきません・・・笑
このフォルダとはどこに作られてるのですか?
質問しといて、変な質問でごめんなさい。

(兎年) 2023/03/23(木) 13:00:03


 > 5)4)で作成したシートの、B2セルに、フォルダを作っていきたいアドレスを入力してください。
(稲葉) 2023/03/23(木) 13:01:52

稲葉さま

なんだか上手くいった気がします。
感動しかありません。
いまの結果は下記の通りです。

   A    B    C 
1
2     D:\Users\PC3\Desktop
3  0001 〇〇工事
4
5
6
7    1 〇〇工事  230323作成

実際にデスクトップにもきちんとフォルダが作成されました!

この後に試すことはなんでしょうか。
   
(兎年) 2023/03/23(木) 13:24:13


 そのレイアウトだと
 > 4)mkSheetLayout を1回だけ実行して、テスト環境を整えてください。
 これ実行してなくない?

 何やるべきか
  ちゃんと読め

(稲葉) 2023/03/23(木) 13:28:18


稲葉さま

すみません、申し訳ないです。
新しいブックを作成して、もう一度いちから試してみます。
(兎年) 2023/03/23(木) 13:31:55


稲葉さま

(4)の工程が抜けていました。
mkSheetLayoutを実行したらきちんとできました。

A7から0001にはじまり、9999まで作成されています。

私がやりたかったことが詰め込まれています。
なんとお礼を言ったら良いか。
最後はお気を悪くさせてしまい申し訳ございませんでした。
(兎年) 2023/03/23(木) 13:45:48


 気分を害すとかはないんですが、質問者さんのレベルに合わせて注釈入れたり入れなかったりしてるので(今回はがっつりいれたツモリだった・・・)
 それ読んでもらわないと意味ないなーとガッカリすることはあります。

https://www.excelspeedup.com/vbadebug/

 ↑
 今後デバッグ方法とかもわかるといいと思うので、是非トライしてみてください。
(稲葉) 2023/03/23(木) 16:06:04

稲葉さま

ご返信頂けると思いませんでした。
仰る通りです。無償でこんなに親切にして頂いているのに100パーこちらに非があります。

デバッグ方法ありがとうございます。
これを機にVBAの勉強心に火がつきました。
道半ばで時間かかりますが、まだまだやりたい事がありまた質問させてもらうかもしれません。
私を見かけたら是非またご教授頂ければ幸いです。
(兎年) 2023/03/24(金) 15:03:11


稲葉さま

作成した自分のパソコンではトントンと上手く行くのですが、他のパソコンからアクセスし実行するとデバッグが出てしまい、そこからどのパソコンでやっても実行不能になってしまいます。
デバッグの情報を見て稲葉さまから頂いたデバッグ方法も見てみたのですが、どうにもこうにも行かずつまづいております・・・

デバッグ情報
BASErng.Offset(i - 1, 1).Locked = True

とでています。
お手すきでしたらご教授頂ければ幸いです。
(兎年) 2023/03/31(金) 13:30:08


稲葉さんではないけど

1)そのコードは Case Dir(mkfp, vbDirectory) = "" の節と Case Else の節の2箇所あるんだけど、どっち?
2)エラーが出てるなら、エラーメッセージも教えてね
3)パソコン以外に変えたことがあるなら書いてね(シートやセルの設定など)
(ufj) 2023/03/31(金) 15:19:08


ufjさん

すみません、ありがとうございます。涙

どうやら違うパソコンからとかどうのという話では無く、一度閉じて開くと出てしまう事が判明しました。

1)デバッグの黄色コードの下にはCase Elseと書かれていますがこのことでしょうか?
2)実行時エラー'1004': RangeクラスのLockedプロパティを設定できません。
3)最初に設定してもらった連番(0001〜9999)を異なる連番に手入力で直しています。
(兎年) 2023/03/31(金) 15:28:50


待て待て待てw
>異なる連番に手入力で直しています
これができるってことは、その前に「シートの保護を手動で外す」もやってない?
(ufj) 2023/03/31(金) 15:36:05

え、やってます 汗
ダメなんですね?無知でごめんなさい。
保護を外さず、ちょっとまたイチからやってみます!
(兎年) 2023/03/31(金) 15:56:14

いや、それ自体がダメだとは思ってない。

4)まさかとは思うけど、B列に結合セル作った?

まぁ↑が原因なら、イチから(シートつくるところから)やり直したら解決するからやってみて。
(ufj) 2023/03/31(金) 16:01:53


4)いいえ、結合はしてません。基本頂いた場所で実行してました。
やったことは保護を手動で外して番号を変えてしまったことです。グスン
最初からやってみます。ありがとうございました。
(兎年) 2023/03/31(金) 16:11:14

 ufjさんフォローありがとうございます。

 この1行を
            .Protect Password:=myPassWord, userinterfaceonly:=True

        With Sheets(1)
 の直下に挿入してください。
 UserInterFaceOnlyが開きなおすたびに実行しないとだめなの忘れてました

(稲葉) 2023/03/31(金) 16:23:12


あっそういうのもあるのか(結合じゃないなら、なんやかんやしてるうちにうっかりロックしたセルを再ロックしようとしてる?と思ってた人)

/*実はこれ便利だなーと昨日から使わせていただいておりまして、
ひとさまの質問のおかげで書いていただいたものを使っている後ろめたさから首をつっこみました。
こちらこそありがとうございます。
(ufj) 2023/03/31(金) 16:28:51


ufjさん、稲葉さん

ありがとうございます。
私の分からない会話が飛び交っていますが本当に感謝しています・・・

番号を1〜9999ではなくて、自分の思っている番号に作成することはVBAにて成功しました。
次に、
4)mkSheetLayout を1回だけ実行して、テスト環境を整えてください。

↑これを実行すると、保護がかかり他の編集が出来なくなってしまいます。
これを実行する前に作りたい物を作成しておくべきという認識で合っていますか?

セルの幅を調整したり、シートを増やしたり、マクロ実行ボタンを作りたかったりという作業が主にです。
(兎年) 2023/03/31(金) 16:45:43


 >(稲葉) 2023/03/31(金) 16:23:12
 これ実施してもらえれば、手動で解除してもらってレイアウト変えても大丈夫ですよ。
 ただ、myPassWordに設定したパスワード以外でロックするとエラー出ます。

 >うっかりロックしたセルを再ロックしようとしてる?
 これは、何度実行しても大丈夫です!

 今回はこちらの不手際です。
 ご迷惑おかけしました。
(稲葉) 2023/03/31(金) 17:03:28

とんでもございません。
感謝しかありません。

 With Sheets(1)
こちら確認したところ2箇所ありました。
2箇所とも
.Protect Password:=myPassWord, userinterfaceonly:=True
を入れて宜しかったでしょうか。

(兎年) 2023/03/31(金) 17:14:32


 DirectoryMaking
 の中は一か所だと思うけどなぁ・・・
(稲葉) 2023/03/31(金) 17:34:50

 '//フォルダを作成するマクロ。案件名を入力し実行すると、フォルダを作成して案件名を編集できないようにロックを掛ける
    Sub DirectoryMaking()

こちらの With Sheets(1)ですね?
ありがとうございます。
やってみます!
(兎年) 2023/03/31(金) 17:39:36


涙涙涙涙

上手く行きました!デバッグも出ません!
レイアウト編集も出来ました!
超感激です!完璧です!

新年度4月からの運用が無事にできそうです。

まだ仕上げがあるのでもう少し頑張ります!

本当にありがとうございました。

(兎年) 2023/03/31(金) 19:04:02


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.