エクセルで一定数毎に数値を追加したい

質問

WINの複数OSで、Office2007を使用しています。
ビデオテープの管理をエクセルでしています。
エクセルへの入力情報としては、、撮影日：箱番号：撮影場所：タイトル：テープ種別（LとS）というようなカテゴリーにしてあります。
ビデオテープはLとSの2種類でLはL、SはS専用の箱に入れて管理します。
箱にはL、S共に１０本単位で保管し、L2013-0001、S2013-0001というようにそれぞれに箱ナンバーを付けます。
テープもL、S共に１０本に達したら箱の番号は
L2013-0002（Sも同様）というように１０本に達したら次の箱にというような管理をしたいのです。
一本ごとのテープのシリアルナンバーでの管理は必要ではありません。
あくまで箱とテープ（１０本）のマッチングをしたいのです。
１０本ごとに箱番号の数値を１増やして自動管理をしたいのです。
そしてテープにも箱番号を貼り付けたいと思っています。
エクセルは自分で入力はできるのですが、自動計算する方法をほとんど知りません。Lは、L2013-0001、SもS2013-0001と貼り付け、どの箱に戻せばよいのかを貼り付けて管理したいと考えています。
一枚のシートでLもSも管理できると検索が楽だと考えています。
エクセルの関数？VBA？というのを使用して１０本ごとにテープと箱の関連性を確認するのが目的です。
どのようにすればよいのか教えていただけませんでしょうか。
よろしくお願いします。

回答No.3

keithin · ベストアンサー

Ａ列に年/月/日で撮影日，Ｂ列に箱番号，Ｅ列にテープ種別が記入されているとして
今やりたいことは
１）テープ種別ごとに
２）撮影日によって年番号を付加し
３）その１０本ごとに箱番号を付加したい
です。

Ｂ２：
=IF(A2="","",E2&YEAR(A2)&TEXT(CEILING(COUNTIFS($E$2:E2,E2,$A$2:A2,">="&DATE(YEAR(A2),1,1)),10)/10,"-0000"))
と記入，以下コピーして埋めておきます。

お礼

本当にありがとうございました。
書いて下さったプログラム？をこちらのエクセルに貼り付けて、何度もエラーを重ねながら
セルの位置の調整を行ったらプログラムが動き数値が目的通り自動入力できました。
ありがとうございました。

回答No.2

KURUMITO

例えばA1セルに撮影日、B1セルに箱番号、C1セルに撮影日、D1セルにタイトル、E1セルにテープ種別の項目名がそれぞれ入力されており各データは2行目から下方に入力されるとします。
E列のテープ種別ではSやLの文字を入力するとします。
そこでB2セルには次の式を入力して下方にドラッグコピーします。

=IF(E2="","",E2&"2013-"&TEXT(ROUNDUP(COUNTIF(E$2:E2,E2)/10,0),"0000"))

これでE列にはSやLが10本ごとに箱番号が変わって表示されます。

お礼

ありがとうございます。
非常に助かりました。
自分には意味が理解出来ませんが、本当に助かりました。
勉強すればもっと仕事が効率化できると感じました。

回答No.1

Prome_Lin

今、第１行目に以下のような項目があり、

撮影日　　箱番号　　撮影場所　　タイトル　　テープ種別

２行目以降の「テープ種別」（＝「Ｅ」列）に以下のようなデータが
入力されたとします。

L
S
S
S
L
L
S
L
L
L
S
S
L
S
S
S
L
L
S
L
S
S
L
L
L
S
S
S
L
L
S
L
L
L
S
S
L
S
S
S
L
L
S
L
S
S
L
L

この条件下で、以下の「VBA」を実行すると、

Sub Sample()
Dim r, l, n, s, i, u As Integer
Dim m, t As Single
Dim c As String
r = Range("E1").End(xlDown).Row
l = 0: n = 0
s = 0: u = 0
For i = 2 To r
　　c = Cells(i, 5).Value
　　If c = "L" Or c = "l" Then
　　　　l = l + 1
　　　　m = l Mod 10
　　　　If m = 0 Then
　　　　　　n = n + 1
　　　　　　Cells(i, 2).Value = "L2013-" & Right("0000" & CStr(n), 4)
　　　　End If
　　ElseIf c = "S" Or c = "s" Then
　　　　s = s + 1
　　　　t = s Mod 10
　　　　If t = 0 Then
　　　　　　u = u + 1
　　　　　　Cells(i, 2).Value = "S2013-" & Right("0000" & CStr(u), 4)
　　　　End If
　　End If
Next i
End Sub

「L」や「S」がそれぞれ10個目ずつの行の「箱番号」（＝「Ｂ」列）に
以下の内容が自動的に出力されます。

S2013-0001
L2013-0001
S2013-0002
L2013-0002

これが、思っておられる処理に間違いないか分かりませんが…

なお、プログラムが、余りにも美しくありませんが、
ご容赦ください。

最後に、何より、このプログラムでは、
実行するたびに、すでに処理が済んでいる所を（例えばL2013-0001）
何度も書き換えるという、無用なことをしているように思えますし、
何より、このままだと、「Ｌ」や「Ｓ」を直して、再びプログラムを実行すると、
前の「L2013-0001」という表示が残ったままになってしまうので、
手作業で消しておく必要があります。

そう考えると、余りにも不完全なプログラムですが、、
よかったら、参考にしてください。

お礼

これは、ＶＢＡというものですよね
こういうことも含めて、書ける方はすごいなと感じました。
エクセルを入力にしか使用していなかったので色々簡略化させて、
正確に行えるのだと感じました。
本当にありがとうございました。