戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
このトピック参照回数 :
シリアルの自動割り振り

    [195495] シリアルの自動割り振り-

    ■親トピック/記事引用/メール受信=OFF■

    □投稿者/ りっちゃん -(2023/01/14(21:45))
    □U R L/

      sheet1
      A     B    C    D   E             
      1 商品番号 商品名 日付 個数 シリアル  
      2 1 リンゴ 1/10   2  T12456-T12457 
      3  2 イチゴ  1/10   1  T12220
      4 3    桃    1/10 3 T12221・TT1235-TT1236

      sheet2
         A    B     C    D 
      1|商品番号  1     2    3
      2|商品名  リンゴ  イチゴ   桃
      3|日付   1/10    1/10   1/10
      4|個数    2     1    3
      5|シリアル T12456  T12220  T12221 
      6|     T12457       TT1235
      7|               TT1236

      sheet1からsheet2に横に自動でシリアルを振るようにしたいです。
      −の場合は連番で・の場合は1つです

      毎日100件位あり手作業でコピーしているので自動で出来るようにしたいです。
      マクロで出来ますか?


      ++++++++++++++++++++
      OS      ⇒Windows XP
      Version⇒Excel 2007
      ++++++++++++++++++++




    [195496] Re[1]: シリアルの自動割り振り-

    記事引用/メール受信=OFF■

    □投稿者/ 半平太 -(2023/01/15(08:55))
    □U R L/
      シリアルって、入力ミスは起きないですか?
      
      ・の場合は1つなので、ミスられてもプログラム側は、知ーらないと言えますが、
      
      -の場合は連番なので、そうも言ってられない気がするんですが・・
      
      例えば、
      TT112-TT115 が正しいのに、
      TT112-TT15  と入れて、マイナスになったり、、
      TT112-TT1115と入れて、飛んでもない連番になったりした時、
      それくらいプログラムの方でチェックしてよ、ってな要求が出ませんかね?
      
      あと、いつもアルファベット+連番 の形になっているんですか?
      アルファベット+連番+アルファベット とかの形もあったりするんですか?




    [195497] Re[2]: シリアルの自動割り振り-

    すいませ〜ん。誰か〜! / 記事引用/メール受信=OFF■

    □投稿者/ りっちゃん -(2023/01/16(18:57))
    □U R L/

      お返事ありがとうございます。
      最後は必ず数字です。
      間にアルファベットは入りますがT1X222などです。
      連番は150位です。
      どうでしょうか?
      毎日、同じ繰り返しなので出来れば、いいなと思ったのですが…
      宜しくお願い致します。




    [195498] Re[3]: シリアルの自動割り振り-

    記事引用/メール受信=OFF■

    □投稿者/ 半平太 -(2023/01/16(20:15))
    □U R L/
      いま気付いたのですが、個数とシリアルは合致すべきなんですね?
      
      もし、どっちかを入力ミスして、合致しなかったらどう処理しますか?
      
      それとも、間違えっこないので、そんなこと考えなくていいですか?




    [195499] Re[4]: シリアルの自動割り振り-

    記事引用/メール受信=OFF■

    □投稿者/ 半平太 -(2023/01/16(23:37))
    □U R L/
      個数とシリアルの数が合致しないときは、メッセージを出すことにします。
      
      Sub AutoAssignment()
          Dim aCell As Range, brk, Serial, i As Long, k As Long, preSt As String
          Dim regE As Object, dicT As Object, St, Ed, Itm, Rw As Long, msg As String
          
          Worksheets("Sheet2").UsedRange.ClearContents
          
          With Worksheets("Sheet2")
              Worksheets("Sheet1").Range("A1").CurrentRegion.Copy
              .Range("A1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
              
              Set dicT = CreateObject("Scripting.Dictionary")
              Set regE = CreateObject("VBScript.RegExp")
              regE.Pattern = "[0-9]+$"
              regE.Global = True
              
              For Each aCell In .Range("B5", .Cells(5, .Columns.Count).End(xlToLeft))
                  
                  If aCell <> "" Then
                      brk = Split(aCell & "・", "・")
                      
                      For i = 0 To UBound(brk) - 1
                          If brk(i) <> "" Then
                              If brk(i) Like "*-*" Then
                                  Serial = Split(brk(i), "-")
                                  St = regE.Execute(Serial(0))(0)
                                  Ed = regE.Execute(Serial(1))(0)
                                  
                                  preSt = Left(Serial(0), Len(Serial(0)) - Len(St))
                                  
                                  If CLng(St) > CLng(Ed) Then
                                      Rw = Rw + 1
                                      dicT(Rw) = brk(i) & Chr(10) & "は番号が逆です"
                                  Else
                                      For k = St To Ed
                                          Rw = Rw + 1
                                          dicT(Rw) = preSt & Format(k, String(Len(St), "0"))
                                      Next k
                                  End If
                              Else
                                  Rw = Rw + 1
                                  dicT(Rw) = brk(i)
                              End If
                          End If
                      Next i
                      
                      Itm = dicT.items
                      .Cells(5, aCell.Column).Resize(dicT.Count) = Application.Transpose(Itm)
                      
                      If dicT.Count <> aCell.Offset(-1) Then
                          msg = msg & Split(aCell.Address(1, 0), "$")(0) & "列、"
                      End If
                      
                      dicT.RemoveAll
                      Rw = 0
                  End If
              Next aCell
              
              If msg <> "" Then
                  MsgBox "個数不一致列" & Chr(10) & Left(msg, Len(msg) - 1)
              End If
              
              .Select
          End With
      End Sub


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [195500] Re[5]: シリアルの自動割り振り-

    記事引用/メール受信=OFF■

    □投稿者/ りっちゃん -(2023/01/17(21:08))
    □U R L/

      こんばんは
      考えなくていいです。
      シリアルは個数に対して割り振りますので。
      早速明日やってみます。
      有難う御座います




    [195501] Re[6]: シリアルの自動割り振り-

    解決!!ありがとうございました! / 記事引用/メール受信=OFF■

    □投稿者/ りっちゃん -(2023/01/18(22:13))
    □U R L/

      上手く出来ました。
      有難う御座いました。



このトピック内容の全ページ数 / [0]

このトピックに書きこむ
Name/
E-Mail/

└>このツリーのレス記事をメールで受信しますか? YES/ NO/
Title/
URL/
Comment/ 通常モード->  図表モード-> (←の場合適当に改行を入れて下さい)
タグが使用できます。例 ⇒ <font color="blue">文字</font>
解決!!ありがとうございました! 解決       保留中です・・・ 保留        迷宮入りorほかあたって見ます・・ 迷宮入       すいませ〜ん。誰か〜! Help! ←※回答者専用
解決したらチェック       保留(コードテスト中など・・)         解決不可orレスが全く付かなくてほかのサイトに行くときなど・・
削除キー/
(半角8文字以内) 


- Child Forum -
Edit:ゆう-G