人に聞けない痔の悩み、これでスッキリ >>

符丁
Aが1、Bが3・・・Jが「0} 更にLと言う前の数字
例えば 数字10の場合=AJ
    数字25の場合=AE
    数字225の場合=BLE
    数字1200の場合=ABJL
    数字10000の場合=AJLJL
Lha前の数字
これをオートSUMで計算できる
VBAと思うのですが、何処にどの様なプログラムを入れれば良いのか
お教え下さい
EXCELは2013(15.0.4981.1000)です

質問者からの補足コメント

  • HAPPY

    今、エクセルに無事VBAを設定できました。
    符丁数字がABC=1,2,3ではなく、英語の単語なのでAからTまでの文字列で
    If Text Like "[A-L]*" Then
    を直さず文字を置き換えましたが、Dim n1 As String などの言葉を調べ 無事出来ました
    VBAの面白さを感じましたので、これから勉強しますのでご教示ください。
    感謝感激で今夜はおいしいビールが飲めます

    No.1の回答に寄せられた補足コメントです。 補足日時:2017/11/28 17:22

A 回答 (6件)

こんばんは。



私が最後にパソコンを教わった先生は、当時72歳でした。それから、4~5年経ちます。
私の教わった先生は、60歳過ぎてからExcelの勉強をしたと言っております。ここの一部の回答者もかなり年齢の上の人がいるようです。

そして、60歳過ぎてからプログラミングの勉強をして。新企業を立ち上げたという人もいますし、また、60歳過ぎてから、VBAを教えることに意欲を持って、実際の場で教えている人もいます。自分の中で固まってしまわなければ、いくつでも、覚えられるものです。
ただ、どこでも、女性陣のほうが強いようです。

>VBAの深さで単に計算式でなく実務応用を考えさせられました。

このExcelには、想像できないような使い方もあります。

私が、例えば、OkWave に移行しないで、教えて!gooにいるのは、ここの掲示板の構造上の問題で、ブラウザを使わずに、Excelで、閲覧しているからなのです。

Excelで、それぞれのカテゴリのリストを取って、必要な内容のものは、テキストにして保存して、そのテキストのID番号やキーワード検索して、そのテキストを開くなんていうことをしています。

世の中、どんどん進んでいるけれども、ついていくこと、覚えることには精いっぱいです。

なお、今回のものを一部修正して、アップロードしておきました

 mx いくつなのかは、正しいのかどうなのかは、まだ、よく検査されていません。
   ActiveCell.FormulaLocal = "=SumChrs(" & Range(Cells(rw, first), Cells(rw, mx )).Address(0, 0) & ")"
   Application.SendKeys "{F2}"
   ElseIf vstg > 0 Then
   ActiveCell.FormulaLocal = "=SumChrs(" & Range(Cells(first, col), Cells(mx, col)).Address(0, 0) & ")"


アップロード先は、
http://bit.ly/2nrPlTR
パスワードは、
URL のQAから後の8桁の数字です。(Open は、本日から、2017/12/18 までです。)
ダウンロード後、右クリック、プロパティーブロック解除をしてください。
よろしかったらお試しください。何かを学ぶきっかけとなったら幸いです。
「EXCEL で符丁計算式を設定したいので」の回答画像6
    • good
    • 0
この回答へのお礼

WindFaller 様
65歳なんてまだまだ若造ですね。 がんばります
実はパスワードですが70679503、50372392 で開けません。再度ご教示をお願いできればと考えております。
すみません。お忙しいところ
今からNO.4-5を勉強します。

お礼日時:2017/12/05 13:29

Excelのオートサム(Σ)ボタンに取りけるコードです。


これは、リボンエディタを使ってファイルに封入します。専用エディタがないとこれは難しいのですが、このように作るという参考まででも構いません。エディタは、Leaf Crations "Office Ribbon Editor" Ver4.4.2 で、それ以上のバージョンはおそらくは偽物だと思います。また、Multilanguage とそうでないものがありますので、そうでないものは、英語だけにしたほうがよいです。
'Excel 2007でも可動します。
'------------------------
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/cust …
<commands>
<command idMso="AutoSum" onAction="CustomAutoSum"/>
</commands>
</customUI>
'-----------------------
'**Excelの標準モジュール**

'CallBack Ribbbon, On Action
'リボンをカスタマイズしないと、以下は動きません。
'組み込んでも、オートサムボタンは通常どおり使えますが、Ctrl キーを押しながら、オートサム(Σ)ボタンを押すと、符丁の計算をしてくれます。こちらは、文字列の判定が厳しくなっています。
'Re.IgnoreCase = True: Re.Pattern = "[A-Z]+"
'"[A-Z]+" は、繋がってれば -(ハイフン)でつなげてよいのですが、そうでなければ、
'[ACNTZ]+ としてください。なお、空白値が入らないように気をつけてください。
'
Option Explicit
Private Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long
Const VK_CONTROL = &H11
Sub CustomAutoSum(control As IRibbonControl, ByRef cancelDefault)
 Dim Re As Object
 Dim c As Variant
 Dim n As Variant
 Dim buf As Double
' Dim buf1 As Variant
 Dim col As Long, rw As Long, mx As Long
 Dim rTxt As String
 Dim vstg As Long
 Dim hstg As Long
 Dim i As Long, first As Long
 
 Application.StatusBar = False
 If TypeName(Selection) <> "Range" Or GetAsyncKeyState(VK_CONTROL) = False Then
  cancelDefault = False
 Exit Sub
 End If
 Set Re = CreateObject("VBScript.RegExp")
 Re.IgnoreCase = True: Re.Pattern = "[A-Z]+"
  col = ActiveCell.Column
  rw = ActiveCell.Row
 If col > 1 Then
  If Re.test(Cells(rw, col - 1).Value) Then
    hstg = col - 1
  End If
 End If
 If rw > 1 Then
  If Re.test(Cells(rw - 1, col).Value) Then
    vstg = rw - 1
  End If
 End If
 If hstg > 0 And vstg = 0 Then
  mx = hstg
 ElseIf vstg > 0 And hstg = 0 Then
  mx = vstg
 ElseIf vstg > 0 And hstg > 0 Then
  mx = vstg
  hstg = 0
 Else
  Exit Sub
 End If
 
 For i = mx - 1 To 1 Step -1
  If hstg > 0 Then
  rTxt = Cells(rw, mx - i).Value
  If Re.test(rTxt) = False Then
   first = mx - i + 1
   End If
  ElseIf vstg > 0 Then
   rTxt = Cells(mx - i, col).Value
   If Re.test(rTxt) = False Then
    first = mx - i + 1
   End If
  End If
 Next i
 If first = 0 Then first = 1
 
   If hstg > 0 Then
   ActiveCell.FormulaLocal = "=SumChrs(" & Range(Cells(rw, first), Cells(rw, mx - i)).Address(0, 0) & ")"
   Application.SendKeys "{F2}"
   ElseIf vstg > 0 Then
   ActiveCell.FormulaLocal = "=SumChrs(" & Range(Cells(first, col), Cells(mx - 1, col)).Address(0, 0) & ")"
   Application.SendKeys "{F2}"
   End If
End Sub

'//

こういうものは、遊びだと言われれば、否定はしませんが、SUM関数そのものは、アメリカの大学の授業の最中に学生二人が作ったという伝説が残っています。その人たちに敬意を払って、こだわざるを得ません。

そして、気持ちの問題なのでしょうけれども、私は、後、どのぐらい続けられるのだろうか、と思います。ここの掲示板を利用している人たちの年齢も、だんだん高くなっているようです。最近は、切磋琢磨というものには似つかわしくない状況が続きます。
    • good
    • 0
この回答へのお礼

WindFaller 様
ありがとうございました。VBAを勉強中で、まだNO.4,5の組み込みはやってませんが、すごい教材で組み込みを切磋琢磨してやってみます。
VBAの深さで単に計算式でなく実務応用を考えさせられました。

お礼日時:2017/12/04 15:07

遅くなりました。


今までとそんなに変わっていないと言われれば、そうかもしれませんが、いくつか苦心しました。カスタマイズしやすいように、文字をきれいに並べました。
合計のSUMChrs() は、100%Excel関数のSUMとは同じではないのですが、似せました。A1:A10 という範囲でも、A1:A5,A7:A8 という引数でも、受けられるようにしました。

'//標準モジュール
Public Function Convert_AtoN(ByVal Text As String)
'文字から数字
 Dim i As Long
 Dim buf As String
 Dim a As String, n As String
 Dim n1 As String
 Text = StrConv(Text, vbNarrow + vbUpperCase)
  For i = 1 To Len(Text)
   a = Mid(Text, i, 1)
   If Not a Like "[A-Z\.]" Then Convert_AtoN = CVErr(xlErrValue): Exit Function
   n = Switch(a = "A", "1", a = "B", "2", _
    a = "C", "3", a = "D", "4", _
    a = "E", "5", a = "F", "6", _
    a = "G", "7", a = "H", "8", _
    a = "I", "9", a = "J", 0, _
    a = "L", n1, a = ".", ".")
   buf = buf & n
   n1 = n
   n = ""
  Next
 Convert_AtoN = Val(buf)
End Function
Public Function Convert_NtoA(ByVal Text As String)
'数字から文字へ
 Dim i As Long
 Dim buf As String
 Dim a As String, n As String
 Dim a1 As String
 If IsNumeric(Text) Then
  For i = 1 To Len(Text)
   n = Mid(Text, i, 1)
   a = Switch(n = "1", "A", n = "2", "B", _
     n = "3", "C", n = "4", "D", _
     n = "5", "E", n = "6", "F", _
     n = "7", "G", n = "8", "H", _
     n = "9", "H", n = "0", "J", _
     n = ".", ".")
   If a1 = a Then a = "L"
   buf = buf & a
   a1 = a: a = ""
  Next
 End If
 Convert_NtoA = buf
End Function
Public Function SumChrs(ParamArray chrs())
'合計(少し甘くできています)
 Dim n As Variant
 Dim c As Variant
 Dim nums As Double
 Dim mTotal As Double
 For Each n In chrs
  If TypeName(n) = "Range" Or IsArray(n) Then
   For Each c In n
    If TypeName(c) = "Range" Then
     c = c.Value
    End If
    If VarType(c) = vbString Then
     If c Like "[A-L]*" Then '*
      nums = Convert_AtoN(c)
     ElseIf IsNumeric(n) Then
      nums = Val(n)
     End If
    End If
    mTotal = mTotal + nums
   Next
  Else
   mTotal = mTotal + n
  End If
 Next
 SumChrs = mTotal
End Function

' ---続き--
    • good
    • 0

#1の回答者です。


>VBAの面白さを感じましたので、これから勉強しますのでご教示ください。
私でよければ、お教えします。

>Dim n1 As String などの言葉を調べ 無事出来ました
VBAに嫌われないで、無事にたどり着けたことは、とても良かったです。

まだ、私としては直したい所がありますし、他にも不具合があるかもしれません。しばらく開けておいてください。

最終的には、アドインにしてあげると良いと思います。そうすれば、拡張子などの制約がなくなります。

それから、オートSUMのカスタマイズ・サンプルコードは、
https://oshiete.goo.ne.jp/qa/9325461.html #6
にあります。リボン・カスタマイザーで作ります。VBマクロ言語ではなく、XMLで書きます。
    • good
    • 0
この回答へのお礼

おはようございます。
早速のお返事ありがとうございます。 ベストアンサーのボタンを押したいのですが、押すと連絡が取れなくなるようなので、もうしばらく空けておきます。
今日もこれからVBAを勉強します。65歳の私には既に難解ですが、HTMLなどでコードは一通り慣れてます(読めるが書けない程度) また検証中 不明点が出ましたらご相談させていただきます。

お礼日時:2017/11/29 09:05

こんにちは



ユーザ定義関数にしてみましたが、不明な点は勝手に限定しています。
・とりあえず大文字の指定文字のみに対応
 (A~JおよびL以外の文字が混ざっている場合は、エラー値になります)
 (無視という案もありそうですが、まずは、エラーとしました)
・Lが連続する場合は、それ以前の意味を持つ文字が連続するものと解釈します
・最初の文字がLだったり、Lが連続する場合は(前の文字が無いので)無視します
・空白文字列や"LLL"のように有効な文字が存在しない場合は0とみなします。

利用法は
 =futyou(A1) あるいは =futyou(A1:A15)
のような記法となります。
引数にセル範囲を指定した場合は、その範囲のセルを符丁と見做した合計値が返されます。
(通常のSUM関数とは異なり、エラーとなる値が混ざっていると結果はエラーになります)

 =futyou(A1)*20 とか =futyou(A1) - futyou(A2)
なども、もちろん可能です。


Function futyou(ByRef r As Range) As Variant

Dim c As Range
Dim v As String, str As String
Dim so As String, st As String
Dim i As Integer, sum

futyou = 0
For Each c In r
 v = c.Value
 str = ""
 so = ""
 For i = 1 To Len(v)
  st = Mid(v, i, 1)
  If st <> "L" Then so = st
  str = str & so
 Next i

 sum = 0
 For i = 1 To Len(str)
  v = Mid(str, i, 1)
  If "A" <= v And v <= "J" Then
   sum = sum * 10 + ((Asc(v) - 64) Mod 10)
  Else
   futyou = CVErr(xlErrValue)
   Exit Function
  End If
 Next i
futyou = futyou + sum
Next c

End Function
    • good
    • 0

こんにちは。



何か不思議な計算ですね。実に面白いです。
もし、ご質問と意味が違っていましたら、見過ごしてください。
まだ、中途の段階です。

'標準モジュール
Function Convert_AtoN(ByVal Text As String)
'文字から数字
 Dim i As Long
 Dim buf As String
 Dim a As String, n As String
 Dim n1 As String
 If Text Like "[A-L]*" Then
  For i = 1 To Len(Text)
   a = Mid(Text, i, 1)
   n = Switch(a = "A", "1", a = "B", "2", a = "C", "3", a = "D", "4", a = "E", "5", _
     a = "F", "6", a = "G", "7", a = "H", "8", a = "I", "9", a = "J", 0, a = "L", n1)
   buf = buf & n
   n1 = n
   n = ""
  Next
 End If
 Convert_AtoN = buf
End Function
Function Convert_NtoA(ByVal Text As String)
'数字から文字へ
 Dim i As Long
 Dim buf As String
 Dim a As String, n As String
 Dim a1 As String
 If IsNumeric(Text) Then
  For i = 1 To Len(Text)
   n = Mid(Text, i, 1)
   a = Switch(n = "1", "A", n = "2", "B", n = "3", "C", n = "4", "D", n = "5", "E", _
     n = "6", "F", n = "7", "G", n = "8", "H", n = "9", "H", n = "0", "J")
   If a1 = a Then a = "L"
   buf = buf & a
   a1 = a: a = ""
  Next
 End If
 Convert_NtoA = buf
End Function
Function SumChrs(ParamArray chrs())
 Dim n As Variant
 Dim c As Variant
 Dim nums As Double
 Dim mTotal As Double
 For Each n In chrs
  If TypeName(n) = "Range" Then
   For Each c In n
    c = c.Value
    If VarType(c) = vbString Then
     If c Like "[A-L]*" Then
      nums = Convert_AtoN(c)
     ElseIf IsNumeric(n) Then
      nums = Val(n)
     End If
    End If
    mTotal = mTotal + nums
   Next
  End If
 Next
 SumChrs = mTotal
End Function
'//

さて使い方ですが、

最初に、添付画像をみてください。
A列はふつうの数字
B列のB1:B5 は、
B1: =Convert_NtoA(A1)
として、ドラッグコピーで、B5 までしています。
B6は、

=Convert_NtoA((SumChrs(B1:B5)))
つまり、数値で出たものを、もう一度、Convert_NtoAで、文字に変換しています。
SumChrs(B1:B5) で、数値の計算は出ています。

C列は、正しいか調べるために、
C1: =Convert_AtoN(B1)
で、C6 までドラッグコピーしています。

当面の実用にはたかられるのですが、では、何が中途かというと、SumChrs(B1:B5)は、SUM関数と同じように、文字を除外したり、単独の引数を入れても、計算するように出来ていますが、これは、まだ、セルの範囲だけなのです。SUM関数と同等の処理ができるには、ちょっと手間が掛かりそうな気がしています。
まだ、LIKE演算子を使った所などは不満を感じています。
>これをオートSUMで計算できる
これについても可能ですが、組み込むことは、一般の人には未知の世界になってしまうと思います。リボンカスタマイズというワザが必要なのです。
「EXCEL で符丁計算式を設定したいので」の回答画像1
この回答への補足あり
    • good
    • 0
この回答へのお礼

早速のご回答ありがとうございます。
実は祖父の時代からABCではなく10桁のローマ字での符丁です。
社員同士は数字はこれで通じ、例えばゴルフ場の風呂場で60も叩いたとは言わずFJなどと周囲の人にはわかりませんし、商売上は原価などをお客様の前で居えないのでつかってます。
今から組み込んで勉強します。
リボンカスタマイズなんて言葉初めて聞きました そこまではあきらめます
うまく組み込めるかが心配です。
取り急ぎ ありがとうございました。

お礼日時:2017/11/28 15:34

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング

おすすめ情報